switch proccessing of vitals and problems so CCR would validate

added date time for ccr
cleaned up template ccr (more to come)
more work done in vitals section
This commit is contained in:
cje 2008-07-03 20:54:25 +00:00
parent e2223f14aa
commit cd6dc2b91d
4 changed files with 764 additions and 784 deletions

View File

@ -1,9 +1,9 @@
CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08 CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
;;0.1;CCRCCD;;Jun 15, 2008; ;;0.1;CCRCCD;;Jun 15, 2008;
W "No Entry at Top!" Q W "No Entry at Top!" Q
FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time) ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
; If not passed, or passed incorrectly, it's assumed that it is D. ; If not passed, or passed incorrectly, it's assumed that it is D.
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied. ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
@ -15,12 +15,13 @@ FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrins
S D=$E(DATE,6,7) S D=$E(DATE,6,7)
S H=$E(DATE,9,10) S H=$E(DATE,9,10)
S MM=$E(DATE,11,12) S MM=$E(DATE,11,12)
S S=$E(DATE,12,13) S S=$E(DATE,13,14)
S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation. S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
; If H, MM and S are empty, it means that the FM date didn't supply the time. ; If H, MM and S are empty, it means that the FM date didn't supply the time.
; In this case, set H, MM and S to "00" ; In this case, set H, MM and S to "00"
S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00"
S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF I S="" S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_OFF
E S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF
I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time. I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
E Q $P(UTC,"T") E Q $P(UTC,"T")
; ;

View File

@ -1,152 +1,153 @@
GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate ;;0.1;CCDCCR;nopatch;noreleasedate
; ;
; EXPORT A CCR ; EXPORT A CCR
; ;
EXPORT ; EXPORT ENTRY POINT FOR CCR EXPORT ; EXPORT ENTRY POINT FOR CCR
; Select a patient. ; Select a patient.
S DIC=2,DIC(0)="AEMQ" D ^DIC S DIC=2,DIC(0)="AEMQ" D ^DIC
I Y<1 Q ; EXIT I Y<1 Q ; EXIT
S DFN=$P(Y,U,1) ; SET THE PATIENT S DFN=$P(Y,U,1) ; SET THE PATIENT
N CCRGLO N CCRGLO
D CCRRPC(.CCRGLO,DFN,"CCR","","","") D CCRRPC(.CCRGLO,DFN,"CCR","","","")
S OARY=$NA(^TMP($J,DFN,"CCR",1)) S OARY=$NA(^TMP($J,DFN,"CCR",1))
S ONAM="PAT_"_DFN_"_CCR_V1.xml" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
S ODIR="/home/glilly/CCROUT" S ODIR="/home/glilly/CCROUT"
;S ODIR="/home/cedwards/" ;S ODIR="/home/cedwards/"
D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
Q Q
; ;
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; CCRGRTN IS RETURN ARRAY PASSED BY NAME ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; DFN IS PATIENT IEN ; DFN IS PATIENT IEN
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
; - NULL MEANS NOW ; - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
; "TO" VARIABLES ; "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S DEBUG=0 S DEBUG=0
S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
; ;
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
; ;
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
; ;
K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
. S IXML="INXML" . S IXML="INXML"
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
. ; W OXML,! . ; W OXML,!
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
. W "RUNNING ",CALL,! . W "RUNNING ",CALL,!
. X CALL . X CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
Q Q
; ;
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
; TAB IS PASSED BY NAME ; TAB IS PASSED BY NAME
; W "TAB= ",TAB,! ; W "TAB= ",TAB,!
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
Q Q
; ;
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
; K @VMAP ; K @VMAP
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT")
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES,
I IHDR'="" D ; HEADER VALUES ARE PROVIDED . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY I IHDR'="" D ; HEADER VALUES ARE PROVIDED
N CTMP . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
D MAP^GPLXPATH(CXML,VMAP,"CTMP") N CTMP
D CP^GPLXPATH("CTMP",CXML) D MAP^GPLXPATH(CXML,VMAP,"CTMP")
Q D CP^GPLXPATH("CTMP",CXML)
; Q
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML ;
; AXML AND ACTRTN ARE PASSED BY NAME ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 ; AXML AND ACTRTN ARE PASSED BY NAME
; P1= OBJECTID - ACTORPATIENT_2 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE ; P1= OBJECTID - ACTORPATIENT_2
; OR INSTITUTION ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
; OR PERSON(IN PATIENT FILE IE NOK) ; OR INSTITUTION
; P3= IEN RECORD NUMBER FOR ACTOR - 2 ; OR PERSON(IN PATIENT FILE IE NOK)
N I,J,K,L ; P3= IEN RECORD NUMBER FOR ACTOR - 2
K @ACTRTN ; CLEAR RETURN ARRAY N I,J,K,L
F I=1:1:@AXML@(0) D ; SCAN ALL LINES K @ACTRTN ; CLEAR RETURN ARRAY
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
. . W "<ActorID>=>",J,! . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
. . I J'="" S K(J)="" ; HASHING ACTOR . . W "<ActorID>=>",J,!
. . ; TO GET RID OF DUPLICATES . . I J'="" S K(J)="" ; HASHING ACTOR
S I="" ; GOING TO $O THROUGH THE HASH . . ; TO GET RID OF DUPLICATES
F J=0:0 D Q:$O(K(I))="" S I="" ; GOING TO $O THROUGH THE HASH
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS F J=0:0 D Q:$O(K(I))=""
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
Q . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
; Q
TEST ; RUN ALL THE TEST CASES ;
D TESTALL^GPLUNIT("GPLCCR") TEST ; RUN ALL THE TEST CASES
Q D TESTALL^GPLUNIT("GPLCCR")
; Q
ZTEST(WHICH) ; RUN ONE SET OF TESTS ;
N ZTMP ZTEST(WHICH) ; RUN ONE SET OF TESTS
D ZLOAD^GPLUNIT("ZTMP","GPLCCR") N ZTMP
D ZTEST^GPLUNIT(.ZTMP,WHICH) D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
Q D ZTEST^GPLUNIT(.ZTMP,WHICH)
; Q
TLIST ; LIST THE TESTS ;
N ZTMP TLIST ; LIST THE TESTS
D ZLOAD^GPLUNIT("ZTMP","GPLCCR") N ZTMP
D TLIST^GPLUNIT(.ZTMP) D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
Q D TLIST^GPLUNIT(.ZTMP)
; Q
;;><TEST> ;
;;><PROBLEMS> ;;><TEST>
;;>>>K GPL S GPL="" ;;><PROBLEMS>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") ;;>>>K GPL S GPL=""
;;>>?@GPL@(@GPL@(0))["</Problems>" ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;><VITALS> ;;>>?@GPL@(@GPL@(0))["</Problems>"
;;>>>K GPL S GPL="" ;;><VITALS>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") ;;>>>K GPL S GPL=""
;;>>?@GPL@(@GPL@(0))["</VitalSigns>" ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
;;><CCR> ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
;;>>>K GPL S GPL="" ;;><CCR>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") ;;>>>K GPL S GPL=""
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>" ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;><ACTLST> ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
;;>>>K GPL S GPL="" ;;><ACTLST>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") ;;>>>K GPL S GPL=""
;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;></TEST> ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
;;></TEST>

File diff suppressed because it is too large Load Diff

View File

@ -1,49 +1,85 @@
GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08 GPLVITALS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/03/08
;;0.1;CCDCCR;nopatch;noreleasedate ;;0.1;CCDCCR;;JUL 3,2008;
EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
; ;
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
; ;
N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
D VITALS^ORQQVI(.VITRSLT,DFN,"","") D VITALS^ORQQVI(.VITRSLT,DFN,"","")
I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
;ZWR RPCRSLT ; ZWR RPCRSLT
S VITTVMAP=$NA(^TMP($J,"VITALS")) S VITTVMAP=$NA(^TMP($J,"VITALS"))
S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP")) S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST
. I $D(VITRSLT(J)) D . I $D(VITRSLT(J)) D
. . S VITVMAP=$NA(@VITTVMAP@(J)) . . S VITVMAP=$NA(@VITTVMAP@(J))
. . K @VITVMAP . . K @VITVMAP
. . I DEBUG W "VMAP= ",VMAP,! . . I DEBUG W "VMAP= ",VMAP,!
. . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
. . S @VITVMAP@("DATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
. . I $P(VITPTMP,U,2)="HT" D . . I $P(VITPTMP,U,2)="HT" D
. . . S @VITVMAP@("HEIGHTWEIGHTDATATIME")=$P(VITPTMP,U,4) . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7) . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("HEIGHTSOURCEID")=$P(VITPTMP,U,1) . . . W "CONVERTED DATE TIME: ",@VITVMAP@("VITALSIGNSEXACTDATETIME"),!
. . . S @VITVMAP@("HEIGHTINCHES")=$P(VITPTMP,U,3) . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
. . I $P(VITPTMP,U,2)="WT" D . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
. . . S @VITVMAP@("WEIGHTSOURCEID")=$P(VITPTMP,U,1) . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
. . . S @VITVMAP@("WEIGHTLBS")=$P(VITPTMP,U,3) . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
. . S VITARYTMP=$NA(@VITTARYTMP@(J)) . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
. . K @VITARYTMP . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
. . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP) . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
. . I J=1 D ; FIRST ONE IS JUST A COPY . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
. . . ; W "FIRST ONE",! . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML) . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
. . . ; W "OUTXML ",OUTXML,! . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML . . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP) . . E I $P(VITPTMP,U,2)="WT" D
;ZWR ^TMP($J,"VITALS",*) . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
;ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
; W "OUT OF FOR LOOP.",! . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
;ZWR . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
; ZWR @OUTXML . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
; $$HTML^DILF( . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
N VITTMP,I . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
D MISSING^GPLXPATH(VITXML,"VITTMP") ; SEARCH XML FOR MISSING VARS . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
. W "VITALS MISSING ",! . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
. F I=1:1:VITTMP(0) W VITTMP(I),! . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
Q . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
. . E D
. . . ;W "IN VITAL: OTHER",!
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
. . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
. . K @VITARYTMP
. . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
. . I J=1 D ; FIRST ONE IS JUST A COPY
. . . ; W "FIRST ONE",!
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
. . . ; W "OUTXML ",OUTXML,!
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
; ZWR ^TMP($J,"VITALS",*)
; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
; ZWR @OUTXML
N VITTMP,I
D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
. W "VITALS MISSING ",!
. F I=1:1:VITTMP(0) W VITTMP(I),!
Q
;