Changed CCRUTIL to C0CUTIL

This commit is contained in:
sam 2009-03-16 00:14:48 +00:00
parent b2d5a805af
commit 771afac3ad
17 changed files with 42 additions and 39 deletions

View File

@ -109,7 +109,7 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
. D GETN1^C0CRNF("C0CG1",120.8,DFN,"B") ;GET VALUES BY NAME . D GETN1^C0CRNF("C0CG1",120.8,DFN,"B") ;GET VALUES BY NAME
. S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
. S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CT) . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT)
. K @ALTARYTMP . K @ALTARYTMP
. D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
. I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)

View File

@ -183,7 +183,7 @@ UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
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("C0CCCR",$J,DFN,"HEADER")) N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
; K @VMAP ; K @VMAP
S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???

View File

@ -144,7 +144,7 @@ INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
; K @VMAP ; K @VMAP
S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
D ; ALWAYS MAP THESE VARIABLES D ; ALWAYS MAP THESE VARIABLES
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN

View File

@ -78,7 +78,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
. . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
. . W C0CIEN,"_",C0CIMD . . W C0CIEN,"_",C0CIMD
. . S C0CT=$$FMDTOUTC^CCRUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
. . W C0CT,! . . W C0CT,!
. . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
. . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME

View File

@ -182,7 +182,7 @@ LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CX2,"DT") ;UTC TIME . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
@ -220,7 +220,7 @@ LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CX2,"DT") ;UTC TIME . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
. . ; I 'C0CQT ZWR XV . . ; I 'C0CQT ZWR XV
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
. I 'C0CQT D ; . I 'C0CQT D ;

View File

@ -53,8 +53,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
. S @VMAP@("PROBLEMCODINGVERSION")="" . S @VMAP@("PROBLEMCODINGVERSION")=""
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,5),"DT") . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,6),"DT") . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
@ -65,8 +65,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
. S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,15),"DT") . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
. S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,16),"DT") . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
. S ARYTMP=$NA(@TARYTMP@(J)) . S ARYTMP=$NA(@TARYTMP@(J))
. ; W "ARYTMP= ",ARYTMP,! . ; W "ARYTMP= ",ARYTMP,!
. K @ARYTMP . K @ARYTMP

View File

@ -36,7 +36,7 @@ VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
S G="" S GN=0 S G="" S GN=0
F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ; F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ;
. S GN=GN+1 . S GN=GN+1
. W $$FMDTOUTC^CCRUTIL(9999999-G),! . W $$FMDTOUTC^C0CUTIL(9999999-G),!
Q Q
; ;
VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV
@ -47,7 +47,7 @@ VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV
I '$D(C0CCNT) S C0CCNT=99999999 I '$D(C0CCNT) S C0CCNT=99999999
F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT) D ; F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT) D ;
. S GN=GN+1 . S GN=GN+1
. W $$FMDTOUTC^CCRUTIL(C0CG),! . W $$FMDTOUTC^C0CUTIL(C0CG),!
Q Q
; ;
NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE
@ -76,7 +76,7 @@ GETNV(C0CDFN) ;GET MANY VISITS
S APCDPAT=C0CDFN ; S APCDPAT=C0CDFN ;
N C0CG S C0CG="" N C0CG S C0CG=""
F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG="" D ; LOOP BACKWARD THROUGH VISITS F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG="" D ; LOOP BACKWARD THROUGH VISITS
. W C0CG," ",$$FMDTOUTC^CCRUTIL(C0CG),! . W C0CG," ",$$FMDTOUTC^C0CUTIL(C0CG),!
. S APCDVLDT=C0CG . S APCDVLDT=C0CG
. D ^APCDVLK . D ^APCDVLK
. D ^APCDVD . D ^APCDVD

View File

@ -1,6 +1,7 @@
CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
;;0.1;CCRCCD;;Jun 15, 2008; ;;0.1;C0C;;Jun 15, 2008;
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU ;Copyright 2008-2009 Sam Habiel & George Lily.
;Licensed under the terms of the GNU
;General Public License See attached copy of the License. ;General Public License See attached copy of the License.
; ;
;This program is free software; you can redistribute it and/or modify ;This program is free software; you can redistribute it and/or modify
@ -121,3 +122,5 @@ DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
. W DASTMP,"=",DASNO,! ; PRINT IT OUT . W DASTMP,"=",DASNO,! ; PRINT IT OUT
Q Q
; ;
RPMS ; Are we running on an RPMS system rather than Vista?
Q $G(DUZ("AG")="I") ; If User Agency is Indian Health Service

View File

@ -45,7 +45,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
; I DEBUG ZWR VDATES ;DEBUG ; I DEBUG ZWR VDATES ;DEBUG
S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST
@ -55,12 +55,12 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . I DEBUG W "VMAP= ",VITVMAP,! . . I DEBUG W "VMAP= ",VITVMAP,!
. . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
. . I DEBUG W "VITAL ",VSORT(J),! . . I DEBUG W "VITAL ",VSORT(J),!
. . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),! . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
. . I DEBUG W $P(VITPTMP,U,4),! . . I DEBUG W $P(VITPTMP,U,4),!
. . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
. . I $P(VITPTMP,U,2)="HT" D . . I $P(VITPTMP,U,2)="HT" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -74,7 +74,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
. . E I $P(VITPTMP,U,2)="WT" D . . E I $P(VITPTMP,U,2)="WT" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -88,7 +88,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
. . E I $P(VITPTMP,U,2)="BP" D . . E I $P(VITPTMP,U,2)="BP" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -102,7 +102,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
. . E I $P(VITPTMP,U,2)="T" D . . E I $P(VITPTMP,U,2)="T" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -116,7 +116,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
. . E I $P(VITPTMP,U,2)="R" D . . E I $P(VITPTMP,U,2)="R" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -130,7 +130,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
. . E I $P(VITPTMP,U,2)="P" D . . E I $P(VITPTMP,U,2)="P" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -144,7 +144,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
. . E I $P(VITPTMP,U,2)="PN" D . . E I $P(VITPTMP,U,2)="PN" D
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
@ -159,7 +159,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . E D . . E D
. . . ;W "IN VITAL: OTHER",! . . . ;W "IN VITAL: OTHER",!
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT") . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL" . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J

View File

@ -110,7 +110,7 @@ DISPNAME(DFN) ; Display Name
DOB(DFN) ; Date of Birth DOB(DFN) ; Date of Birth
N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I") N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
; Date in FM Date Format. Convert to UTC/ISO 8601. ; Date in FM Date Format. Convert to UTC/ISO 8601.
Q $$FMDTOUTC^CCRUTIL(DOB,"D") Q $$FMDTOUTC^C0CUTIL(DOB,"D")
GENDER(DFN) ; Gender/Sex GENDER(DFN) ; Gender/Sex
Q $$GET1^DIQ(2,DFN,.02) ; Q $$GET1^DIQ(2,DFN,.02) ;
SSN(DFN) ; SSN SSN(DFN) ; SSN

View File

@ -110,7 +110,7 @@ USERPC ; ENTRY POINT FOR RPMS
. S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
. S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
. I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")="" . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
. E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE . E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^C0CUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
. S @MEDVMAP@("MEDISSUEDATE")="" . S @MEDVMAP@("MEDISSUEDATE")=""
. S @MEDVMAP@("MEDLASTFILLDATETXT")="" . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
. S @MEDVMAP@("MEDLASTFILLDATE")="" . S @MEDVMAP@("MEDLASTFILLDATE")=""

View File

@ -59,9 +59,9 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
. S @MAP@("MEDISSUEDATETXT")="Issue Date" . S @MAP@("MEDISSUEDATETXT")="Issue Date"
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MED(101),U))
. S @MAP@("MEDRXNOTXT")="Prescription Number" . S @MAP@("MEDRXNOTXT")="Prescription Number"
. S @MAP@("MEDRXNO")=MED(.01) . S @MAP@("MEDRXNO")=MED(.01)
. S @MAP@("MEDTYPETEXT")="Medication" . S @MAP@("MEDTYPETEXT")="Medication"

View File

@ -65,7 +65,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
. ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
. S @MAP@("MEDISSUEDATETXT")="Issue Date" . S @MAP@("MEDISSUEDATETXT")="Issue Date"
. ; Field 6 is "Effective date", and we pull it in timson format w/ I . ; Field 6 is "Effective date", and we pull it in timson format w/ I
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT") . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
. ; Med never filled; next 4 fields are not applicable. . ; Med never filled; next 4 fields are not applicable.
. S @MAP@("MEDLASTFILLDATETXT")="" . S @MAP@("MEDLASTFILLDATETXT")=""
. S @MAP@("MEDLASTFILLDATE")="" . S @MAP@("MEDLASTFILLDATE")=""

View File

@ -64,7 +64,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
. S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
. S @MAP@("MEDISSUEDATETXT")="Documented Date" . S @MAP@("MEDISSUEDATETXT")="Documented Date"
. ; Field 6 is "Effective date", and we pull it in timson format w/ I . ; Field 6 is "Effective date", and we pull it in timson format w/ I
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL(MED(11,"I"),"DT") . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
. ; Med never filled; next 4 fields are not applicable. . ; Med never filled; next 4 fields are not applicable.
. S @MAP@("MEDLASTFILLDATETXT")="" . S @MAP@("MEDLASTFILLDATETXT")=""
. S @MAP@("MEDLASTFILLDATE")="" . S @MAP@("MEDLASTFILLDATE")=""

View File

@ -62,7 +62,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
. I DEBUG W "MAP= ",MAP,! . I DEBUG W "MAP= ",MAP,!
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
. S @MAP@("MEDISSUEDATETXT")="Order Date" . S @MAP@("MEDISSUEDATETXT")="Order Date"
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(27),U),"DT") . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
. S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
. S @MAP@("MEDRXNOTXT")="" ; For Outpatient . S @MAP@("MEDRXNOTXT")="" ; For Outpatient

View File

@ -68,9 +68,9 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. I DEBUG W "MAP= ",MAP,! . I DEBUG W "MAP= ",MAP,!
. S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
. S @MAP@("MEDISSUEDATETXT")="Issue Date" . S @MAP@("MEDISSUEDATETXT")="Issue Date"
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MEDS(MEDCNT),U,13)) . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13))
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MEDS(MEDCNT),U,11)) . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11))
. S @MAP@("MEDRXNOTXT")="Prescription Number" . S @MAP@("MEDRXNOTXT")="Prescription Number"
. S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14) . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
. S @MAP@("MEDTYPETEXT")="Medication" . S @MAP@("MEDTYPETEXT")="Medication"

View File

@ -1,6 +1,6 @@
CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008 CCRVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
;;0.1;CCDCCR;;JUL 13, 2007;Build 0 ;;0.1;C0C;;JUL 13, 2007;Build 0
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU ;Copyright 2008 Sam Habiel. Licensed under the terms of the GNU
;General Public License See attached copy of the License. ;General Public License See attached copy of the License.
; ;
;This program is free software; you can redistribute it and/or modify ;This program is free software; you can redistribute it and/or modify