Changeset 355 for ccr

Timestamp:

Feb 3, 2009, 5:36:00 PM (16 years ago)

Author:

George Lilly

Message:

immune codes for RPMS

File:

• ccr/trunk/p/GPLIMMU.m (modified) (3 diffs)

ccr/trunk/p/GPLIMMU.m

@@ -28 +28 @@
  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
  ;
@@ -69 +71 @@
  . 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
@@ -79 +81 @@
  . . 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
  ;