immune codes for RPMS

This commit is contained in:
george 2009-02-03 22:36:00 +00:00
parent 8e0ee0561f
commit bfab33053b
1 changed files with 31 additions and 83 deletions

View File

@ -27,14 +27,16 @@ MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
S C0CZV=$NA(^TMP("GPLCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
S C0CZIC=@C0CZV@(0) ; TOTAL FROM VARIABLE ARRAY
F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
. S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
. D MAP^GPLXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
. I C0CZI=1 D ; FIRST ONE
. . D CP^GPLXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
. E D ;NOT THE FIRST
. . D INSINNER^GPLXPATH(OUTXML,"C0CZT")
S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
I C0CZIC>0 D ;IMMUNIZATIONS FOUND
. F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
. . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
. . D MAP^GPLXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
. . I C0CZI=1 D ; FIRST ONE
. . . D CP^GPLXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
. . E D ;NOT THE FIRST
. . . D INSINNER^GPLXPATH(OUTXML,"C0CZT")
E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
Q
;
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
@ -68,7 +70,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
. S C0CIMD="" ; IMMUNE DATE
. F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE
. . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD TO PULL IENS
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
. . W C0CIEN,"_",C0CIMD
. . S C0CT=$$FMDTOUTC^CCRUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
. . W C0CT,!
@ -78,80 +80,26 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
. . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
. . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
. . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
. . ; FOR LOOKING UP THE CODE (TBD GPL)
. . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
. . ; GET IT FROM THE CODE FILE CHANGE THIS (TBD GPL)
. . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
. . S @VMAP@("IMMUNEPRODUCTCODE")="" ;FIX THIS
. . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;FIX THIS
Q
. S VMAP=$NA(@TVMAP@(J))
. K @VMAP
. I DEBUG W "VMAP= ",VMAP,!
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",1:"")
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
. S @VMAP@("PROBLEMCODINGVERSION")=""
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,5),"DT")
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,6),"DT")
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
. S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
. S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
. S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
. S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
. S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,15),"DT")
. S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,16),"DT")
. S ARYTMP=$NA(@TARYTMP@(J))
. ; W "ARYTMP= ",ARYTMP,!
. K @ARYTMP
. D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
. I J=1 D ; FIRST ONE IS JUST A COPY
. . ; W "FIRST ONE",!
. . D CP^GPLXPATH(ARYTMP,OUTXML)
. . ; W "OUTXML ",OUTXML,!
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
; ZWR @OUTXML
; $$HTML^DILF(
; GENERATE THE NARITIVE HTML FOR THE CCD
I CCD D ; IF THIS IS FOR A CCD
. N HTMP,HOUT,HTMLO,GPLPROBI,ZX
. F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
. . S VMAP=$NA(@TVMAP@(GPLPROBI))
. . I DEBUG W "VMAP =",VMAP,!
. . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
. . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
. . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
. . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
. . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
. . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY
. . . D CP^GPLXPATH("HOUT","HTMLO")
. . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
. . . I DEBUG W "DOING INNER",!
. . . N HTMLBLD,HTMLTMP
. . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
. . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
. . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
. . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
. . . D CP^GPLXPATH("HTMLTMP","HTMLO")
. . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
. I DEBUG D PARY^GPLXPATH("HTMLO")
. D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
N PROBSTMP,I
D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
. . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS
. . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
. . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
. . . ; FOR LOOKING UP THE CODE
. . . ; GET IT FROM THE CODE FILE
. . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
. . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
. . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
. . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
. . E D ; NOT IN RPMS
. . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
. . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
. . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
N IMMUTMP,I
D MISSING^GPLXPATH(ARYTMP,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -
. ; STRINGS MARKED AS @@X@@
. W !,"PROBLEMS Missing list: ",!
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
. W !,"IMMUNE Missing list: ",!
. F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
Q
;