- Timestamp:
- Oct 6, 2008, 11:46:35 AM (17 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
-
CCRMEDS.m (modified) (1 diff)
-
CCRMEDS1.m (modified) (3 diffs)
-
CCRMEDS2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS.m
r185 r186 1 1 CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08 14:33 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;0.1;CCDCCR;;JUL 16,2008; 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 23 EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 24 ; 25 ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 27 ; 28 N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS 29 N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED 30 ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1 31 ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2 32 ; NON-VA MEDS IN EXTRACT^CCRMEDS3 33 ; INPATIENT MEDS IN EXTRACT^CCRMEDS4 34 ; ALL OTHERS HERE 35 D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS 36 I @MEDOUTXML@(0)>0 D ; CCRMEDS FOUND ACTIVE OP MEDS 37 . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML 38 . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP 39 . W "HAS ACTIVE OP MEDS",! 40 N PENDINGXML,MEDPENDING 41 S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY 42 D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS 43 I @PENDINGXML@(0)>0 D ; CCRMEDS FOUND PENDING OP MEDS 44 . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML 45 . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS 46 . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE 47 . E D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY 48 . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP 49 . W "HAS OP PENDING MEDS",! 50 N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF 51 D ACTIVE^ORWPS(.MEDRSLT,DFN) 52 I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT 53 . I DEBUG W "MEDICATIONS RPC RETURNED NULL",! 54 . S @MEDOUTXML@(0)=0 55 . Q 56 ; I DEBUG ZWR MEDRSLT 57 M GPLMEDS=MEDRSLT 58 S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 59 S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP")) 60 I 'HASOP K @MEDTVMAP,@MEDTARYTMP 61 ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS 62 ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI 63 N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED 64 ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES 65 S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS 66 F ZJ=1:1 Q:'$D(MEDRSLT(ZJ)) D ; COUNT THE MEDS AND LINES 67 . I MEDRSLT(ZJ)?1"~".E D ; FOUND NEW MED 68 . . S ZI=ZI+1 ; INCREMENT MED COUNT 69 . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS 70 . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT 71 . E D ; FOR EVERY LINE NOT A FIRST LINE IN MED 72 . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED 73 . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY 74 ;ZWR ZA 75 S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS 76 F ZI=1:1:ZA(0) D ; FOR EACH MED 77 . I DEBUG W "ZI IS ",ZI,! 78 . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS 79 . K @MEDVMAP 80 . I DEBUG W "VMAP= ",MEDVMAP,! 81 . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT 82 . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED 83 . I $P(MEDPTMP,U,1)?1"~OP" Q ; SKIP OP ACTIVE AND PENDING 84 . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS 85 . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")="" 86 . E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE 87 . S @MEDVMAP@("MEDISSUEDATE")="" 88 . S @MEDVMAP@("MEDLASTFILLDATETXT")="" 89 . S @MEDVMAP@("MEDLASTFILLDATE")="" 90 . S @MEDVMAP@("MEDRXNOTXT")="" 91 . S @MEDVMAP@("MEDRXNO")="" 92 . S @MEDVMAP@("MEDDETAILUNADORNED")="" 93 . S @MEDVMAP@("MEDCONCVALUE")="" 94 . S @MEDVMAP@("MEDCONCUNIT")="" 95 . S @MEDVMAP@("MEDSIZETEXT")="" 96 . S @MEDVMAP@("MEDDOSEINDICATOR")="" 97 . S @MEDVMAP@("MEDDELIVERYMETHOD")="" 98 . S @MEDVMAP@("MEDRATEVALUE")="" 99 . S @MEDVMAP@("MEDRATEUNIT")="" 100 . S @MEDVMAP@("MEDVEHICLETEXT")="" 101 . S @MEDVMAP@("MEDFREQUENCYUNIT")="" 102 . S @MEDVMAP@("MEDINTERVALVALUE")="" 103 . S @MEDVMAP@("MEDINTERVALUNIT")="" 104 . S @MEDVMAP@("MEDPRNFLAG")="" 105 . S @MEDVMAP@("MEDPROBLEMOBJECTID")="" 106 . S @MEDVMAP@("MEDPROBLEMTYPETXT")="" 107 . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")="" 108 . S @MEDVMAP@("MEDPROBLEMCODEVALUE")="" 109 . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")="" 110 . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")="" 111 . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")="" 112 . S @MEDVMAP@("MEDSTOPINDICATOR")="" 113 . S @MEDVMAP@("MEDDIRSEQ")="" 114 . S @MEDVMAP@("MEDMULDIRMOD")="" 115 . S @MEDVMAP@("MEDPTINSTRUCTIONS")="" 116 . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 117 . S @MEDVMAP@("MEDDATETIMEAGE")="" 118 . S @MEDVMAP@("MEDDATETIMEAGEUNITS")="" 119 . S @MEDVMAP@("MEDTYPETEXT")="Medication" 120 . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC 121 . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1" 122 . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3) 123 . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE 124 . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="" 125 . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")="" 126 . I $P(MEDPTMP,U,1)?1"~OP" D ; IS OUTPATIENT, MIGHT HAVE CODE 127 . . I $P(MEDPTMP,"^",10)="ACTIVE" D ; ONLY ACTIVE MEDS HAVE CODES 128 . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT 129 . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS 130 . . . I DEBUG W "RXIEN=",RXIEN,! ; 131 . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP 132 . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D ; IF SUCCESS 133 . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27) 134 . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 135 . S @MEDVMAP@("MEDBRANDNAMETEXT")="" 136 . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")="" 137 . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")="" 138 . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")="" 139 . S @MEDVMAP@("MEDSTRENGTHVALUE")="" 140 . S @MEDVMAP@("MEDSTRENGTHUNIT")="" 141 . S @MEDVMAP@("MEDFORMTEXT")="" 142 . S @MEDVMAP@("MEDQUANTITYVALUE")="" 143 . S @MEDVMAP@("MEDQUANTITYUNIT")="" 144 . S @MEDVMAP@("MEDRFNO")="" 145 . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED 146 . I ZK>1 D ; MORE THAN ONE LINE IN MED 147 . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2) 148 . I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS 149 . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE 150 . . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED 151 . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP 152 . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT 153 . . . E S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE 154 . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR 155 . S @MEDVMAP@("MEDDOSEVALUE")="" 156 . S @MEDVMAP@("MEDDOSEUNIT")="" 157 . S @MEDVMAP@("MEDFREQUENCYVALUE")="" 158 . S @MEDVMAP@("MEDDURATIONVALUE")="" 159 . S @MEDVMAP@("MEDDURATIONUNIT")="" 160 . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")="" 161 . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")="" 162 . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI)) 163 . K @MEDARYTMP 164 . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP) 165 . I ZI=1&('HASOP) D ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE 166 . . ; W "FIRST ONE",! 167 . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML) 168 . E D ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML 169 . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP) 170 N MEDTMP,MEDI 171 D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 172 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 173 . W "MEDICATION MISSING ",! 174 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 175 Q 176 ; 177 177 DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING 178 179 180 181 182 178 ; EXAMPLE: $$DIGITS("13R") RETURNS 13 179 N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS 180 S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS 181 Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS 182 ; -
ccr/trunk/p/CCRMEDS1.m
r182 r186 113 113 . ; 114 114 . N DIRNUM S DIRNUM=0 ; Sigline number 115 . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS 115 116 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D 116 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 117 . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 117 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT 118 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 119 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 118 120 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0) 119 . . S @MAP@("M", DIRNUM,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)120 . . S @MAP@("M", DIRNUM,"MEDDOSEVALUE")=$P(SIGDATA,U,1)121 . . S @MAP@("M", DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")122 . . S @MAP@("M", DIRNUM,"MEDRATEVALUE")="" ; For inpatient123 . . S @MAP@("M", DIRNUM,"MEDRATEUNIT")="" ; For inpatient124 . . S @MAP@("M", DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient125 . . S @MAP@("M", DIRNUM,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)126 . . S @MAP@("M", DIRNUM,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)121 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) 122 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1) 123 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 124 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 125 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 126 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 127 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) 128 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8) 127 129 . . ; Invervals... again another call. 128 130 . . ; In the wisdom of the original programmers, the schedule is a free text field … … 141 143 . . . N SUB S SUB=$O(SCHEDATA(0)) 142 144 . . . S INTERVAL=SCHEDATA(SUB,2) 143 . . S @MAP@("M", DIRNUM,"MEDINTERVALVALUE")=INTERVAL144 . . S @MAP@("M", DIRNUM,"MEDINTERVALUNIT")="Minute"145 . . S @MAP@("M", DIRNUM,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)146 . . S @MAP@("M", DIRNUM,"MEDDURATIONUNIT")=""147 . . S @MAP@("M", DIRNUM,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"148 . . S @MAP@("M", DIRNUM,"MEDPROBLEMOBJECTID")=""149 . . S @MAP@("M", DIRNUM,"MEDPROBLEMTYPETXT")=""150 . . S @MAP@("M", DIRNUM,"MEDPROBLEMDESCRIPTION")=""151 . . S @MAP@("M", DIRNUM,"MEDPROBLEMCODEVALUE")=""152 . . S @MAP@("M", DIRNUM,"MEDPROBLEMCODINGSYSTEM")=""153 . . S @MAP@("M", DIRNUM,"MEDPROBLEMCODINGVERSION")=""154 . . S @MAP@("M", DIRNUM,"MEDPROBLEMSOURCEACTORID")=""155 . . S @MAP@("M", DIRNUM,"MEDSTOPINDICATOR")=""156 . . S @MAP@("M", DIRNUM,"MEDDIRSEQ")=DIRNUM145 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 146 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 147 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5) 148 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 149 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN" 150 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" 151 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 152 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 153 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 154 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 155 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 156 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 157 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" 158 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM 157 159 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6) 158 . . S @MAP@("M", DIRNUM,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")160 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"") 159 161 . ; 160 162 . ; --- END OF DIRECTIONS --- … … 169 171 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 170 172 . ; D PARY^GPLXPATH(RESULT) 173 . ; MAPPING DIRECTIONS 174 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 175 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 176 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 177 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions") 178 . ; N MDZ1,MDZNA 179 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 180 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 181 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 182 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2) 183 . . . D INSINNER^GPLXPATH(RESULT,DIRXML2) 171 184 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 172 185 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML -
ccr/trunk/p/CCRMEDS2.m
r184 r186 1 1 CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;0.1;CCDCCR;;JUL 16,2008; 3 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ; General Public License See attached copy of the License. 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License along 17 ; with this program; if not, write to the Free Software Foundation, Inc., 18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 23 EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; MINXML is the Input XML Template, passed by name 26 ; DFN is Patient IEN 27 ; OUTXML is the resultant XML. 28 ; 29 ; MEDS is return array from RPC. 30 ; MAP is a mapping variable map (store result) for each med 31 ; MED is holds each array element from MEDS, one medicine 32 ; 33 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending 34 ; meds data available. 35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 37 ; File for pending meds is 52.41 38 ; Unfortuantely, API does not supply us with any useful info beyond 39 ; the IEN in 52.41, and the Med Name, and route. 40 ; So, most of the info is going to get pulled from 52.41. 41 N MEDS,MAP 42 K ^TMP($J) 43 D PEN^PSO5241(DFN,"CCDCCR") 44 M MEDS=^TMP($J,"CCDCCR",DFN) 45 ; @(0) contains the number of meds or -1^NO DATA FOUND 46 ; If it is -1, we quit. 47 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 48 I DEBUG ZWR MEDS 49 N RXIEN S RXIEN=0 50 N MEDCOUNT S MEDCOUNT=0 51 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST 52 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order 53 . S MEDCOUNT=MEDCOUNT+1 54 . I DEBUG W "RXIEN IS ",RXIEN,! 55 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) 56 . K @MAP 57 . I DEBUG W "MAP= ",MAP,! 58 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 59 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN 60 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 61 . ; Field 6 is "Effective date", and we pull it in timson format w/ I 62 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I")) 63 . ; Med never filled; next 4 fields are not applicable. 64 . S @MAP@("MEDLASTFILLDATETXT")="" 65 . S @MAP@("MEDLASTFILLDATE")="" 66 . S @MAP@("MEDRXNOTXT")="" 67 . S @MAP@("MEDRXNO")="" 68 . S @MAP@("MEDTYPETEXT")="Medication" 69 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 70 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds 71 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") 72 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) 73 . ; NDC not supplied in API, but is rather trivial to obtain 74 . ; MED(11) piece 1 has the IEN of the drug (file 50) 75 . ; IEN is field 31 in the drug file. 76 . N MEDIEN S MEDIEN=$P(MED(11),U) 77 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E") 78 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 79 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 80 . S @MAP@("MEDBRANDNAMETEXT")="" 81 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 82 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 83 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 84 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 85 . ; Units, concentration, etc, come from another call 86 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 87 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 88 . ; NDF Entry IEN, and VA Product Name 89 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 90 . ; Documented in the same manual. 91 . D NDF^PSS50(MEDIEN,,,,,"CONC") 92 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) 93 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 94 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 95 . N CONCDATA 96 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 97 . ; and this will crash the call. So... 98 . I NDFIEN="" S CONCDATA="" 99 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 100 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 101 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 102 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 103 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) 104 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) 105 . ; Oddly, there is no easy place to find the dispense unit. 106 . ; It's not included in the original call, so we have to go to the drug file. 107 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 108 . ; Node 14.5 is the Dispense Unit 109 . D DATA^PSS50(MEDIEN,,,,,"QTY") 110 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 111 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 112 . ; 113 . ; --- START OF DIRECTIONS --- 114 . ; Sig data is not in any API. We obtain it using the IEN from 115 . ; the PEN API to file 52.41. It's in field 3, which is a multiple. 116 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) 117 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call 118 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") 119 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. 120 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 121 . ; DIRNUM will be first piece for IEN. 122 . ; DIRNUM is the proper Sigline numer. 123 . ; SIGDATA is the simplfied array. Subscripts are really field numbers 124 . ; in subfile 52.413. 125 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D 126 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") 127 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) 128 . . ; If this is an order for a refill; it's not really a new order; move on to next 129 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 130 . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 131 . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=SIGDATA(13) 132 . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=SIGDATA(8) 133 . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 134 . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient 135 . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient 136 . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient 137 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) 138 . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=SIGDATA(1) 139 . . ; Invervals... again another call. 140 . . ; The schedule is a free text field 141 . . ; However, it gets translated by a call to the administration 142 . . ; schedule file to see if that schedule exists. 143 . . ; That's the same thing I am going to do. 144 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 145 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 146 . . ; I looked), PSSFT is the name, 147 . . ; and list is the ^TMP name to store the data in. 148 . . ; Also, freqency may have "PRN" in it, so strip that out 149 . . N FREQ S FREQ=SIGDATA(1) 150 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp 151 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") 152 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 153 . . N INTERVAL 154 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 155 . . E D 156 . . . N SUB S SUB=$O(SCHEDATA(0)) 157 . . . S INTERVAL=SCHEDATA(SUB,2) 158 . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL 159 . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute" 160 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months 161 . . N DUR S DUR=SIGDATA(2) 162 . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) 163 . . N DURUNIT S DURUNIT=$E(DUR) 164 . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") 165 . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=SIGDATA(1)["PRN" 166 . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")="" 167 . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")="" 168 . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")="" 169 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")="" 170 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")="" 171 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")="" 172 . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")="" 173 . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field 174 . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM 175 . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=SIGDATA(6) 176 . ; 177 . ; --- END OF DIRECTIONS --- 178 . ; 179 . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 180 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" 181 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) 182 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) 183 . K @RESULT 184 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 185 . ; D PARY^GPLXPATH(RESULT) 186 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 187 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 188 N MEDTMP,MEDI 189 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 190 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 191 . W "MEDICATION MISSING ",! 192 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 193 Q 194 ; 24 ; 25 ; MINXML is the Input XML Template, passed by name 26 ; DFN is Patient IEN 27 ; OUTXML is the resultant XML. 28 ; 29 ; MEDS is return array from RPC. 30 ; MAP is a mapping variable map (store result) for each med 31 ; MED is holds each array element from MEDS, one medicine 32 ; 33 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending 34 ; meds data available. 35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 37 ; File for pending meds is 52.41 38 ; Unfortuantely, API does not supply us with any useful info beyond 39 ; the IEN in 52.41, and the Med Name, and route. 40 ; So, most of the info is going to get pulled from 52.41. 41 N MEDS,MAP 42 K ^TMP($J) 43 D PEN^PSO5241(DFN,"CCDCCR") 44 M MEDS=^TMP($J,"CCDCCR",DFN) 45 ; @(0) contains the number of meds or -1^NO DATA FOUND 46 ; If it is -1, we quit. 47 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 48 I DEBUG ZWR MEDS 49 N RXIEN S RXIEN=0 50 N MEDCOUNT S MEDCOUNT=0 51 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST 52 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order 53 . S MEDCOUNT=MEDCOUNT+1 54 . I DEBUG W "RXIEN IS ",RXIEN,! 55 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) 56 . K @MAP 57 . I DEBUG W "MAP= ",MAP,! 58 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 59 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN 60 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 61 . ; Field 6 is "Effective date", and we pull it in timson format w/ I 62 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I")) 63 . ; Med never filled; next 4 fields are not applicable. 64 . S @MAP@("MEDLASTFILLDATETXT")="" 65 . S @MAP@("MEDLASTFILLDATE")="" 66 . S @MAP@("MEDRXNOTXT")="" 67 . S @MAP@("MEDRXNO")="" 68 . S @MAP@("MEDTYPETEXT")="Medication" 69 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 70 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds 71 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") 72 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) 73 . ; NDC not supplied in API, but is rather trivial to obtain 74 . ; MED(11) piece 1 has the IEN of the drug (file 50) 75 . ; IEN is field 31 in the drug file. 76 . N MEDIEN S MEDIEN=$P(MED(11),U) 77 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E") 78 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 79 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 80 . S @MAP@("MEDBRANDNAMETEXT")="" 81 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 82 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 83 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 84 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 85 . ; Units, concentration, etc, come from another call 86 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 87 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 88 . ; NDF Entry IEN, and VA Product Name 89 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 90 . ; Documented in the same manual. 91 . D NDF^PSS50(MEDIEN,,,,,"CONC") 92 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) 93 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 94 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 95 . N CONCDATA 96 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 97 . ; and this will crash the call. So... 98 . I NDFIEN="" S CONCDATA="" 99 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 100 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 101 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 102 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 103 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) 104 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) 105 . ; Oddly, there is no easy place to find the dispense unit. 106 . ; It's not included in the original call, so we have to go to the drug file. 107 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 108 . ; Node 14.5 is the Dispense Unit 109 . D DATA^PSS50(MEDIEN,,,,,"QTY") 110 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 111 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 112 . ; 113 . ; --- START OF DIRECTIONS --- 114 . ; Sig data is not in any API. We obtain it using the IEN from 115 . ; the PEN API to file 52.41. It's in field 3, which is a multiple. 116 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) 117 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call 118 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") 119 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. 120 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 121 . ; DIRNUM will be first piece for IEN. 122 . ; DIRNUM is the proper Sigline numer. 123 . ; SIGDATA is the simplfied array. Subscripts are really field numbers 124 . ; in subfile 52.413. 125 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS 126 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D 127 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") 128 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT 129 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) 130 . . ; If this is an order for a refill; it's not really a new order; move on to next 131 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 132 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 133 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13) 134 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8) 135 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 136 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 137 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 138 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 139 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) 140 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1) 141 . . ; Invervals... again another call. 142 . . ; The schedule is a free text field 143 . . ; However, it gets translated by a call to the administration 144 . . ; schedule file to see if that schedule exists. 145 . . ; That's the same thing I am going to do. 146 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 147 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 148 . . ; I looked), PSSFT is the name, 149 . . ; and list is the ^TMP name to store the data in. 150 . . ; Also, freqency may have "PRN" in it, so strip that out 151 . . N FREQ S FREQ=SIGDATA(1) 152 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp 153 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") 154 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 155 . . N INTERVAL 156 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 157 . . E D 158 . . . N SUB S SUB=$O(SCHEDATA(0)) 159 . . . S INTERVAL=SCHEDATA(SUB,2) 160 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 161 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 162 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months 163 . . N DUR S DUR=SIGDATA(2) 164 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) 165 . . N DURUNIT S DURUNIT=$E(DUR) 166 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") 167 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN" 168 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" 169 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 170 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 171 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 172 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 173 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 174 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 175 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field 176 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM 177 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6) 178 . ; 179 . ; --- END OF DIRECTIONS --- 180 . ; 181 . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 182 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" 183 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) 184 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) 185 . K @RESULT 186 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 187 . ; D PARY^GPLXPATH(RESULT) 188 . ; MAPPING DIRECTIONS 189 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 190 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 191 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 192 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions") 193 . ; N MDZ1,MDZNA 194 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 195 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 196 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 197 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2) 198 . . . D INSINNER^GPLXPATH(RESULT,DIRXML2) 199 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 200 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 201 N MEDTMP,MEDI 202 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 203 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 204 . W "MEDICATION MISSING ",! 205 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 206 Q 207 ;
Note:
See TracChangeset
for help on using the changeset viewer.
