CCRMEDS again

This commit is contained in:
sam 2008-09-22 00:24:01 +00:00
parent 7bff13c4dd
commit 9c30ed5e09
2 changed files with 23 additions and 24 deletions

View File

@ -44,9 +44,11 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
I DEBUG ZWR MEDS I DEBUG ZWR MEDS
N RXIEN S RXIEN=0 N RXIEN S RXIEN=0
N MEDCOUNT S MEDCOUNT=0
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
. S MEDCOUNT=MEDCOUNT+1
. I DEBUG W "RXIEN IS ",RXIEN,! . I DEBUG W "RXIEN IS ",RXIEN,!
. S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J)) . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
. K @MAP . K @MAP
. I DEBUG W "MAP= ",MAP,! . I DEBUG W "MAP= ",MAP,!
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
@ -77,9 +79,8 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. ; NDF Entry IEN, and VA Product Name . ; NDF Entry IEN, and VA Product Name
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
. ; Documented in the same manual. . ; Documented in the same manual.
. N IEN S IEN=^PSDRUG($P(MED(6),U)) . D NDF^PSS50(MEDIEN,,,,,"CONC")
. D NDF^PSS50(IEN,,,,,"CONC") . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
. N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U) . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
. N VAPROD S VAPROD=$P(NDFDATA(22),U) . N VAPROD S VAPROD=$P(NDFDATA(22),U)
. N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
@ -92,8 +93,8 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. ; It's not included in the original call, so we have to go to the drug file. . ; It's not included in the original call, so we have to go to the drug file.
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
. ; Node 14.5 is the Dispense Unit . ; Node 14.5 is the Dispense Unit
. D DATA^PSS50(IEN,,,,,"QTY") . D DATA^PSS50(MEDIEN,,,,,"QTY")
. N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN) . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
. ; . ;
. ; --- START OF DIRECTIONS --- . ; --- START OF DIRECTIONS ---
@ -105,10 +106,10 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. ; It's in node 6 of ^PSRX(IEN) . ; It's in node 6 of ^PSRX(IEN)
. ; So, here we go again . ; So, here we go again
. ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4) . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^ . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
N SIGDATA S SIGDATA=^PSRX(IEN,6,1,0) . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,1,0)
. S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) . S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
. S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1) . S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1)
. S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") . S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
@ -116,7 +117,7 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S @MAP@("MEDRATEUNIT")="" ; For inpatient . S @MAP@("MEDRATEUNIT")="" ; For inpatient
. S @MAP@("MEDVEHICLETEXT")="" ; For inpatient . S @MAP@("MEDVEHICLETEXT")="" ; For inpatient
. S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) . S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
. S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,7) . S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
. ; Invervals... again another call. . ; Invervals... again another call.
. ; In the wisdom of the original programmers, the schedule is a free text field . ; In the wisdom of the original programmers, the schedule is a free text field
. ; However, it gets translated by a call to the administration schedule file . ; However, it gets translated by a call to the administration schedule file
@ -126,10 +127,10 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
. ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in. . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
. ; So... . ; So...
. D AP^PSS51P1("PSJ",$P(SIGDATA,U,7),,,"SCHEDULE") . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
. N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
. N INTERVAL . N INTERVAL
. I SCHEDATA(0)=-1 S INTERVAL="" . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
. E D . E D
. . N SUB S SUB=$O(SCHEDATA(0)) . . N SUB S SUB=$O(SCHEDATA(0))
. . S INTERVAL=SCHEDATA(SUB,2) . . S INTERVAL=SCHEDATA(SUB,2)
@ -137,7 +138,7 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S @MAP@("MEDINTERVALUNIT")="Minute" . S @MAP@("MEDINTERVALUNIT")="Minute"
. S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5) . S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5)
. S @MAP@("MEDDURATIONUNIT")="" . S @MAP@("MEDDURATIONUNIT")=""
. S @MAP@("MEDPRNFLAG")=$P(SIGDATA,U,7)["PRN" . S @MAP@("MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
. S @MAP@("MEDPROBLEMOBJECTID")="" . S @MAP@("MEDPROBLEMOBJECTID")=""
. S @MAP@("MEDPROBLEMDESCRIPTION")="" . S @MAP@("MEDPROBLEMDESCRIPTION")=""
. S @MAP@("MEDPROBLEMCODEVALUE")="" . S @MAP@("MEDPROBLEMCODEVALUE")=""
@ -151,15 +152,15 @@ EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. ; --- END OF DIRECTIONS --- . ; --- END OF DIRECTIONS ---
. ; . ;
. ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE" . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
. S @MAP@("MEDPTINSTRUCTIONS")=^PSRX(RXIEN,"INS1",1,0) . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
. ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command" . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=^PSRX(RXIEN,"PRC",1,0) . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
. S @MAP@("MEDRFNO")=MED(9) . S @MAP@("MEDRFNO")=MED(9)
. N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J)) . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT"))
. K @RESULT . K @RESULT
. D MAP^GPLXPATH(INXML,MAP,RESULT) . D MAP^GPLXPATH(INXML,MAP,RESULT)
. D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
. D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
N MEDTMP,MEDI N MEDTMP,MEDI
D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@

View File

@ -4,20 +4,18 @@ CCRUNIT ; A routine that tests some crap
; ;
MEDS MEDS
N DEBUG S DEBUG=0 N DEBUG S DEBUG=0
N DFN S DFN=1 N DFN S DFN=3
K ^TMP($J) K ^TMP($J)
W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!! W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T) N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
B
N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications" N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
W "XPATH is: "_XPATH,! W "XPATH is: "_XPATH,!
W "Getting Med Template into INXML using",! W "Getting Med Template into INXML using",!
W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!! W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
N INXML N INXML
D QUERY^GPLXPATH(T,XPATH,"INXML") D QUERY^GPLXPATH(T,XPATH,"INXML")
B W "Executing EXTRACT^CCRMEDS(""INXML"",DFN,OUTXML)",!
W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
W "OUTXML will be ^TMP($J,""OUT"")",! W "OUTXML will be ^TMP($J,""OUT"")",!
N OUTXML S OUTXML=$NA(^TMP($J,"OUT")) N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
D EXTRACT^GPLMEDS("INXML",DFN,OUTXML) D EXTRACT^CCRMEDS("INXML",DFN,OUTXML)
Q Q