immune codes for RPMS
This commit is contained in:
parent
8e0ee0561f
commit
bfab33053b
114
p/GPLIMMU.m
114
p/GPLIMMU.m
|
@ -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
|
||||
;
|
||||
|
|
Loading…
Reference in New Issue