Changeset 90 for ccr/trunk/p/GPLMEDS.m

Timestamp:

Aug 17, 2008, 12:49:12 AM (16 years ago)

Author:

Sam Habiel

Message:

Updated CPLCCR0 to include a more comprehensive medication section.

File:

• ccr/trunk/p/GPLMEDS.m (modified) (2 diffs)

ccr/trunk/p/GPLMEDS.m

@@ -18 +18 @@
    ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    ;
-          W "NO ENTRY FROM TOP",!
-          Q
-          ;
+   W "NO ENTRY FROM TOP",!
+   Q
+   ;
 EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    ;
@@ -26 +26 @@
    ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
    ;
-          N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-          D ACTIVE^ORWPS(.MEDRSLT,DFN)
-          I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-          . W "ERROR RUNNINIG MEDICATIONS RPC",!
-          . S @MEDOUTXML@(0)=0
-          . Q
-          IF DEBUG ZWR MEDRSLT
-          S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
-          S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-          F J=1:3 Q:'$D(MEDRSLT(J))  D  ; FOR EACH MEDICATION IN THE LIST
-          . W "J IS ",J,!
-          . S MEDVMAP=$NA(@MEDTVMAP@(J))
-          . K @MEDVMAP
-          . I DEBUG W "VMAP= ",VMAP,!
-          . S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY
-          . S @MEDVMAP@("MEDICATIONOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS
-          . ; PROCESSING FOR MEDS GOES HERE
-          . S @MEDVMAP@("MEDICATIONDATETIMETEXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-          . S @MEDVMAP@("MEDICATIONDATETIMEAGE")=""
-          . S @MEDVMAP@("MEDICATIONDATETIMEAGEUNITS")=""
-          . S @MEDVMAP@("MEDICATIONTYPETEXT")="Medication"
-          . S @MEDVMAP@("MEDICATIONSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-          . S @MEDVMAP@("MEDICATIONSOURCEACTORID")="ACTORSYSTEM_1"
-          . S @MEDVMAP@("MEDICATIONPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-          . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVALUE")=""
-          . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODINGINGSYSTEM")=""
-          . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVERSION")=""
-          . S @MEDVMAP@("MEDICATIONBRANDNAMETEXT")=""
-          . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVALUE")=""
-          . S @MEDVMAP@("MEDICATIONBRANDNAMECODINGSYSTEM")=""
-          . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVERSION")=""
-          . S @MEDVMAP@("MEDICATIONSTRENGTHVALUE")=""
-          . S @MEDVMAP@("MEDICATIONSTRENGTHUNIT")=""
-          . S @MEDVMAP@("MEDICATIONFORMTEXT")=""
-          . S @MEDVMAP@("MEDICATIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2)
-          . S @MEDVMAP@("MEDICATIONDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2)
-          . S @MEDVMAP@("MEDICATIONDIRECTIONDOSEVALUE")=""
-          . S @MEDVMAP@("MEDICATIONDIRECTIONROUTETEXT")=""
-          . S @MEDVMAP@("MEDICATIONDIRECTIONFREQUENCYVALUE")=""
-          . S MEDARYTMP=$NA(@MEDTARYTMP@(J))
-          . K @MEDARYTMP
-          . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-          . . ; W "FIRST ONE",!
-          . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-          . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-          N MEDTMP,MEDI
-          D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-          I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-          . W "MEDICATION MISSING ",!
-          . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-          Q
-          ;
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+   . S @MEDOUTXML@(0)=0
+   . Q
+   IF DEBUG ZWR MEDRSLT
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+   F J=1:3 Q:'$D(MEDRSLT(J))  D  ; FOR EACH MEDICATION IN THE LIST
+   . W "J IS ",J,!
+   . S MEDVMAP=$NA(@MEDTVMAP@(J))
+   . K @MEDVMAP
+   . I DEBUG W "VMAP= ",VMAP,!
+   . S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY
+   . S @MEDVMAP@("MEDICATIONOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS
+   . ; PROCESSING FOR MEDS GOES HERE
+   . S @MEDVMAP@("MEDICATIONDATETIMETEXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+   . S @MEDVMAP@("MEDICATIONDATETIMEAGE")=""
+   . S @MEDVMAP@("MEDICATIONDATETIMEAGEUNITS")=""
+   . S @MEDVMAP@("MEDICATIONTYPETEXT")="Medication"
+   . S @MEDVMAP@("MEDICATIONSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+   . S @MEDVMAP@("MEDICATIONSOURCEACTORID")="ACTORSYSTEM_1"
+   . S @MEDVMAP@("MEDICATIONPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+   . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVALUE")=""
+   . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODINGINGSYSTEM")=""
+   . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVERSION")=""
+   . S @MEDVMAP@("MEDICATIONBRANDNAMETEXT")=""
+   . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVALUE")=""
+   . S @MEDVMAP@("MEDICATIONBRANDNAMECODINGSYSTEM")=""
+   . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVERSION")=""
+   . S @MEDVMAP@("MEDICATIONSTRENGTHVALUE")=""
+   . S @MEDVMAP@("MEDICATIONSTRENGTHUNIT")=""
+   . S @MEDVMAP@("MEDICATIONFORMTEXT")=""
+   . S @MEDVMAP@("MEDICATIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2)
+   . S @MEDVMAP@("MEDICATIONDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2)
+   . S @MEDVMAP@("MEDICATIONDIRECTIONDOSEVALUE")=""
+   . S @MEDVMAP@("MEDICATIONDIRECTIONROUTETEXT")=""
+   . S @MEDVMAP@("MEDICATIONDIRECTIONFREQUENCYVALUE")=""
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(J))
+   . K @MEDARYTMP
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+   . I J=1 D  ; FIRST ONE IS JUST A COPY
+   . . ; W "FIRST ONE",!
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+   . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+   N MEDTMP,MEDI
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+   . W "MEDICATION MISSING ",!
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+   Q
+   ;