Changeset 176 for ccr/trunk


Ignore:
Timestamp:
Oct 4, 2008, 1:03:02 PM (16 years ago)
Author:
George Lilly
Message:

changes for multiple directions

Location:
ccr/trunk/p
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/CCRMEDS.m

    r174 r176  
    11CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
    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 EXTRACT(MINXML,DFN,OUTXML)      ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    24           ;
    25           ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    26           ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
    27           ;
    28           ; MEDS is return array from RPC.
    29           ; MAP is a mapping variable map (store result) for each med
    30           ; MED is holds each array element from MEDS(J), one medicine
    31           ; J is a counter.
    32           ;
    33           ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
    34           ; med 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           ; D PARY^GPLXPATH(MINXML)
    38           N MEDS,MAP
    39           K ^TMP($J)
    40           D RX^PSO52API(DFN,"CCDCCR")
    41           M MEDS=^TMP($J,"CCDCCR",DFN)
    42           ; @(0) contains the number of meds or -1^NO DATA FOUND
    43           ; If it is -1, we quit.
    44           I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
    45           I DEBUG ZWR MEDS
    46           N RXIEN S RXIEN=0
    47           N MEDCOUNT S MEDCOUNT=0
    48           F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
    49           . S MEDCOUNT=MEDCOUNT+1
    50           . I DEBUG W "RXIEN IS ",RXIEN,!
    51           . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
    52           . K @MAP
    53           . I DEBUG W "MAP= ",MAP,!
    54           . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
    55           . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
    56           . S @MAP@("MEDISSUEDATETXT")="Issue Date"
    57           . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
    58           . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
    59           . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
    60           . S @MAP@("MEDRXNOTXT")="Prescription Number"
    61           . S @MAP@("MEDRXNO")=MED(.01)
    62           . S @MAP@("MEDTYPETEXT")="Medication"
    63           . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    64           . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
    65           . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
    66           . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
    67           . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
    68           . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
    69           . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
    70           . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
    71           . N MEDIEN S MEDIEN=$P(MED(6),U)
    72           . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
    73           . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
    74           . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
    75           . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
    76           . ; Units, concentration, etc, come from another call
    77           . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
    78           . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
    79           . ; NDF Entry IEN, and VA Product Name
    80           . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
    81           . ; Documented in the same manual.
    82           . D NDF^PSS50(MEDIEN,,,,,"CONC")
    83           . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
    84           . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
    85           . N VAPROD S VAPROD=$P(NDFDATA(22),U)
    86           . N CONCDATA
    87           . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
    88           . ; and this will crash the call. So...
    89           . I NDFIEN="" S CONCDATA=""
    90           . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
    91           . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
    92           . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
    93           . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
    94           . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
    95           . S @MAP@("MEDQUANTITYVALUE")=MED(7)
    96           . ; Oddly, there is no easy place to find the dispense unit.
    97           . ; It's not included in the original call, so we have to go to the drug file.
    98           . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
    99           . ; Node 14.5 is the Dispense Unit
    100           . D DATA^PSS50(MEDIEN,,,,,"QTY")
    101           . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
    102           . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
    103           . ;
    104           . ; --- START OF DIRECTIONS ---
    105           . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
    106           . ; we want the compoenents.
    107           . ; It's in node 6 of ^PSRX(IEN)
    108           . ; So, here we go again
    109           . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
    110           . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
    111           . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
    112           . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
    113           . ;
    114                   . N DIRNUM S DIRNUM=0 ; Sigline number
    115                   . 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.
    118           . . 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 inpatient
    123           . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")=""  ; For inpatient
    124           . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")=""  ; For inpatient
    125           . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
    126           . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
    127           . . ; Invervals... again another call.
    128           . . ; In the wisdom of the original programmers, the schedule is a free text field
    129           . . ; However, it gets translated by a call to the administration schedule file
    130           . . ; to see if that schedule exists.
    131           . . ; That's the same thing I am going to do.
    132           . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
    133           . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
    134           . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
    135           . . ; So...
    136           . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
    137           . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
    138           . . N INTERVAL
    139           . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
    140           . . E  D
    141           . . . N SUB S SUB=$O(SCHEDATA(0))
    142           . . . S INTERVAL=SCHEDATA(SUB,2)
    143           . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL
    144           . . 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")=DIRNUM
    157                   . . 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:"")
    159           . ;
    160           . ; --- END OF DIRECTIONS ---
    161           . ;
    162           . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
    163           . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
    164           . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
    165           . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
    166           . S @MAP@("MEDRFNO")=MED(9)
    167           . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
    168           . K @RESULT
    169                   . D MAP^GPLXPATH(MINXML,MAP,RESULT)
    170           . ; D PARY^GPLXPATH(RESULT)
    171           . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
    172           . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
    173           N MEDTMP,MEDI
    174           D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
    175           I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    176           . W "MEDICATION MISSING ",!
    177           . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
    178           Q
    179           ;
     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 ;
     23EXTRACT(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
     24 ;
     25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     26 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
     27 ;
     28 ; MEDS is return array from RPC.
     29 ; MAP is a mapping variable map (store result) for each med
     30 ; MED is holds each array element from MEDS(J), one medicine
     31 ; J is a counter.
     32 ;
     33 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
     34 ; med 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 ; D PARY^GPLXPATH(MINXML)
     38 N MEDS,MAP
     39 K ^TMP($J)
     40 D RX^PSO52API(DFN,"CCDCCR")
     41 M MEDS=^TMP($J,"CCDCCR",DFN)
     42 ; @(0) contains the number of meds or -1^NO DATA FOUND
     43 ; If it is -1, we quit.
     44 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
     45 I DEBUG ZWR MEDS
     46 N RXIEN S RXIEN=0
     47 N MEDCOUNT S MEDCOUNT=0
     48 F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
     49 . S MEDCOUNT=MEDCOUNT+1
     50 . I DEBUG W "RXIEN IS ",RXIEN,!
     51 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
     52 . K @MAP
     53 . I DEBUG W "MAP= ",MAP,!
     54 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
     55 . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
     56 . S @MAP@("MEDISSUEDATETXT")="Issue Date"
     57 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
     58 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
     59 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
     60 . S @MAP@("MEDRXNOTXT")="Prescription Number"
     61 . S @MAP@("MEDRXNO")=MED(.01)
     62 . S @MAP@("MEDTYPETEXT")="Medication"
     63 . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
     64 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
     65 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
     66 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
     67 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
     68 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
     69 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
     70 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
     71 . N MEDIEN S MEDIEN=$P(MED(6),U)
     72 . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
     73 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
     74 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
     75 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
     76 . ; Units, concentration, etc, come from another call
     77 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     78 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
     79 . ; NDF Entry IEN, and VA Product Name
     80 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
     81 . ; Documented in the same manual.
     82 . D NDF^PSS50(MEDIEN,,,,,"CONC")
     83 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
     84 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
     85 . N VAPROD S VAPROD=$P(NDFDATA(22),U)
     86 . N CONCDATA
     87 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
     88 . ; and this will crash the call. So...
     89 . I NDFIEN="" S CONCDATA=""
     90 . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
     91 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
     92 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
     93 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
     94 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
     95 . S @MAP@("MEDQUANTITYVALUE")=MED(7)
     96 . ; Oddly, there is no easy place to find the dispense unit.
     97 . ; It's not included in the original call, so we have to go to the drug file.
     98 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
     99 . ; Node 14.5 is the Dispense Unit
     100 . D DATA^PSS50(MEDIEN,,,,,"QTY")
     101 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
     102 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
     103 . ;
     104 . ; --- START OF DIRECTIONS ---
     105 . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
     106 . ; we want the compoenents.
     107 . ; It's in node 6 of ^PSRX(IEN)
     108 . ; So, here we go again
     109 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
     110 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
     111 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
     112 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
     113 . ;
     114 . N DIRNUM S DIRNUM=0 ; Sigline number
     115 . 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.
     118 . . 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 inpatient
     123 . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")=""  ; For inpatient
     124 . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")=""  ; For inpatient
     125 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
     126 . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
     127 . . ; Invervals... again another call.
     128 . . ; In the wisdom of the original programmers, the schedule is a free text field
     129 . . ; However, it gets translated by a call to the administration schedule file
     130 . . ; to see if that schedule exists.
     131 . . ; That's the same thing I am going to do.
     132 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
     133 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
     134 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
     135 . . ; So...
     136 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
     137 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
     138 . . N INTERVAL
     139 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
     140 . . E  D
     141 . . . N SUB S SUB=$O(SCHEDATA(0))
     142 . . . S INTERVAL=SCHEDATA(SUB,2)
     143 . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL
     144 . . 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")=DIRNUM
     157 . . 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:"")
     159 . ;
     160 . ; --- END OF DIRECTIONS ---
     161 . ;
     162 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
     163 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
     164 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
     165 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
     166 . S @MAP@("MEDRFNO")=MED(9)
     167 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
     168 . K @RESULT
     169 . D MAP^GPLXPATH(MINXML,MAP,RESULT)
     170 . ; D PARY^GPLXPATH(RESULT)
     171 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
     172 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
     173 N MEDTMP,MEDI
     174 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
     175 I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
     176 . W "MEDICATION MISSING ",!
     177 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
     178 Q
     179 ;
  • ccr/trunk/p/GPLRIMA.m

    r168 r176  
    410410    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
    411411    N GTMP
    412     D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
     412    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
     413    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
    413414    I '$D(IWHICH) S IWHICH="ALL"
    414415    D RPCGV(.GTMP,DFN,IWHICH)
  • ccr/trunk/p/GPLXPATH.m

    r167 r176  
    433433 F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
    434434 . ; W H2I_"^"_@IHASH@(H2I),!
     435 . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
     436 . . W "GPLZZ",!
     437 . . W $NA(@IHASH@(H2I)),!
     438 . . Q  ;
    435439 . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
    436440 . ; W @IARYRTN@(0),!
Note: See TracChangeset for help on using the changeset viewer.