Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUTL5.m

    r613 r623  
    1 ECXUTL5 ;ALB/JRC - Utilities for DSS Extracts ; 10/17/07 3:49pm
    2         ;;3.0;DSS EXTRACTS;**71,84,92,103,105**;Dec 22, 1997;Build 70
    3         ;
    4 REPEAT(CHAR,TIMES)      ;REPEAT A STRING
    5         ;INPUT  : CHAR - Character to repeat
    6         ;         TIMES - Number of times to repeat CHAR
    7         ;OUTPUT : s - String of CHAR that is TIMES long
    8         ;         "" - Error (bad input)
    9         ;
    10         ;CHECK INPUT
    11         Q:($G(CHAR)="") ""
    12         Q:((+$G(TIMES))=0) ""
    13         ;RETURN STRING
    14         Q $TR($J("",TIMES)," ",CHAR)
    15 INSERT(INSTR,OUTSTR,COLUMN,LENGTH)      ;INSERT A STRING INTO ANOTHER
    16         ;INPUT  : INSTR - String to insert
    17         ;         OUTSTR - String to insert into
    18         ;         COLUMN - Where to begin insertion (defaults to end of OUTSTR)
    19         ;         LENGTH - Number of characters to clear from OUTSTR
    20         ;                  (defaults to length of INSTR)
    21         ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
    22         ;             using LENGTH characters
    23         ;         "" - Error (bad input)
    24         ;
    25         ;NOTE : This module is based on $$SETSTR^VALM1
    26         ;
    27         ;CHECK INPUT
    28         Q:('$D(INSTR)) ""
    29         Q:('$D(OUTSTR)) ""
    30         S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
    31         S:('$D(LENGTH)) LENGTH=$L(INSTR)
    32         ;DECLARE VARIABLES
    33         N FRONT,END
    34         S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
    35         S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
    36         ;INSERT STRING
    37         Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
    38 TYPE(DFN)       ;Determine patient type DBIA #2511
    39         ;   input
    40         ;   DFN = patient ien
    41         ;
    42         ;   output
    43         ;   ECXPTYPE = patient type external value from fle 391
    44         ;
    45         ;          AC = ACTIVE DUTY        MI = MILITARY RETIREE
    46         ;          AL = ALLIED VETERAN     NO = NON-VETERAN (OTHER)
    47         ;          CO = COLLATERAL         NS = NSC VETERAN
    48         ;          EM = EMPLOYEE           SC = SC VETERAN
    49         ;          IN = INELIGIBLE         TR = TRICARE
    50         ;          return value 0 if no data found, 1 if data found
    51         ;
    52         N TYPE,ECXPTYPE
    53         ;Check input
    54         Q:'$D(DFN) ""
    55         S (TYPE,ECXPTYPE)=""
    56         S TYPE=$G(^DPT(DFN,"TYPE"))
    57         I 'TYPE Q ECXPTYPE
    58         S ECXPTYPE=$P($G(^DG(391,TYPE,0)),U,1)
    59         S ECXPTYPE=$E(ECXPTYPE,1,2)
    60         Q ECXPTYPE
    61 CVEDT(DFN,DATE) ;Determine patient CV status DBIA #4156
    62         ;   input
    63         ;   DFN = patient ien
    64         ;
    65         ;   output
    66         ;   ECXCVE = combat veteran status eligibility
    67         ;   ECXCVEDT = combat veteran eligibility end date
    68         ;   ECXCVENC = combat veteran encounter
    69         ;Initialize variables
    70         N CVSTAT
    71         S (CVSTAT,ECXCVE,ECXCVEDT,ECXCVENC)=""
    72         ;Check input
    73         Q:'$D(DFN) 0
    74         ;Call CV API
    75         S CVSTAT=$$CVEDT^DGCV(DFN,DATE)
    76         I CVSTAT<1 Q 0
    77         ;Veteran been given CV eligibility
    78         S ECXCVE=$S($P(CVSTAT,U,3)=1:"Y",$P(CVSTAT,U,3)=0:"E",1:"")
    79         ;Save CV eligibility end date and convert from FM to HL7 format
    80         S ECXCVEDT=$P(CVSTAT,U,2)
    81         S ECXCVEDT=$$FMTHL7^XLFDT(ECXCVEDT)
    82         ;Is the veteran eligible for CV in the date of encounter
    83         S ECXCVENC=$S($P(CVSTAT,U,3)=1:"Y",1:"")
    84         Q 1
    85 NPRF    ;National patient record flags DBIA #3860
    86         N ECXARR,FLG
    87         S ECXNPRFI="",CNT=$$GETACT^DGPFAPI(ECXDFN,"ECXARR"),FLG=""
    88         I 'CNT Q
    89         F I=1:1:CNT D  Q:FLG
    90         .I ECXARR(I,"CATEGORY")["NATIONAL" S ECXNPRFI="Y",FLG=1
    91         Q
    92 RXPTST(K)       ;Rx patient status DBIA #2511
    93         N ECXDIC,STAT
    94         S (ECXDIC,STAT)=""
    95         ;Check input
    96         Q:'$D(K) STAT
    97         S DA=K,DIC="^PS(53,",DIQ(0)="I",DIQ="ECXDIC",DR="6"
    98         D EN^DIQ1
    99         S STAT=$G(ECXDIC(53,K,6,"I"))
    100         S STAT=$S(STAT=1:"SC",STAT=2:"AA",STAT=3:"OTH",STAT=4:"INP",STAT=5:"NON",1:"")
    101         Q STAT
    102 NONVAP(K)       ;Non-va prescriber DBIA #10060
    103         N ECXDIC,NONVAP
    104         S (ECXDIC,NONVAP)=""
    105         Q:'$D(K) NONVAP
    106         S DA=K,DIC="^VA(200,",DIQ(0)="I",DIQ="ECXDIC",DR="53.91"
    107         D EN^DIQ1
    108         S NONVAP=$G(ECXDIC(200,K,53.91,"I"))
    109         I NONVAP S NONVAP="Y"
    110         Q NONVAP
    111 DOIVPO(K,L)     ;Add destination for outpatient ivp orders
    112         ;     Input     K - DFN
    113         ;               L - Order # from Pharmacy Patient File (#55)
    114         ;
    115         ;     Output     ordering stop code
    116         ;
    117         N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
    118         S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
    119         ;Check input
    120         Q:'K!'(L) SCODE
    121         ;Check treating specialty
    122         S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
    123         ;Go to pharmacy patient file (#55) and return value of field (#136)
    124         S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="100",DR(55.01)="136",DA=K,DA(55.01)=L
    125         D EN^DIQ1
    126         S CLINIC=$G(ECXDIC(55.01,L,136,"I"))
    127         I 'CLINIC Q SCODE
    128         ;Get stop code pointer to file 40.7 from file 44
    129         S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
    130         S SCODE=ECXDICA(44,CLINIC,8,"I")
    131         ;Get stop code external value
    132         S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
    133         S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
    134         Q SCODE
    135         ;
    136 DOUDO(K,L)      ;Add destination for outpatient udp orders
    137         ;     Input     K - DFN
    138         ;               L - Order # from Pharmacy Patient File (#55)
    139         ;
    140         ;     Output     ordering stop code
    141         ;
    142         N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
    143         S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
    144         ;Check treating specialty
    145         S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
    146         ;Check input
    147         Q:'K!'(L) SCODE
    148         S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="62",DR(55.06)="130",DA=K,DA(55.06)=L
    149         D EN^DIQ1
    150         S CLINIC=$G(ECXDIC(55.06,L,130,"I"))
    151         I 'CLINIC Q SCODE
    152         ;Get stop code pointer to file 40.7 from file 44
    153         S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
    154         S SCODE=ECXDICA(44,CLINIC,8,"I")
    155         ;Get stop code external value
    156         S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
    157         S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
    158         Q SCODE
    159         ;
    160 PHAAPI(DRUG)    ;Call Pharmacy drug file API dbia 4483
    161         ;   Input: drug file (#50) ien
    162         ;
    163         ;   Output: generic name ^ classification ^ ndc ^ dea hand
    164         ;            ^ ndf file entry # ^ psndf va product entry ^
    165         ;            price per disp unit ^ dispense unit
    166         ;
    167         ;Initialize variables and scratch global
    168         N NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,UNIT,ARRAY,DATA
    169         S (NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,ARRAY,DATA)=""
    170         S ARRAY="^TMP($J,""ECXLIST"")"
    171         K @ARRAY
    172         D DATA^PSS50(DRUG,,,,,"ECXLIST")
    173         I @ARRAY@(0)'>0 Q "^^^^^^"
    174         S NAME=@ARRAY@(DRUG,.01),CLASS=@ARRAY@(DRUG,2),NDC=@ARRAY@(DRUG,31)
    175         S INV=@ARRAY@(DRUG,3),P1=$P(@ARRAY@(DRUG,20),U),P3=$P(@ARRAY@(DRUG,22),U),PPDU=@ARRAY@(DRUG,16),UNIT=@ARRAY@(DRUG,14.5)
    176         K @ARRAY
    177         Q NAME_U_CLASS_U_NDC_U_INV_U_P1_U_P3_U_PPDU_U_UNIT
    178         ;
    179 TSSC(X) ;Check treating specialty (ts) and if ts equals any of the following
    180         ;18,23,24,36,41,65,94 then assign predefined code and return value
    181         ;
    182         ;    Input: treating specialty
    183         ;    Output: Ordering stop code
    184         ;
    185         S CODE=$S(X=18:293,X=23:295,X=24:290,X=36:294,X=41:296,X=65:291,X=94:292,1:"")
    186         Q CODE
    187         ;
    188 PSJ59P5(X)      ;Get iv room division
    189         ;   Input  X - iv room ien
    190         ;
    191         ;   Output - field .02 division
    192         ;Init variables
    193         N DIV S DIV=""
    194         ;Check input
    195         I 'X  Q DIV
    196         D ALL^PSJ59P5(X,,"ECXDIV")
    197         S DIV=$P($G(^TMP($J,"ECXDIV",X,.02)),U)
    198         K ^TMP($J,"ECXDIV")
    199         Q DIV
    200         ;
    201 SCRX(IEN)       ;Service connected prescription
    202         ;Init variables
    203         N DIC,DR,DA,ECXDIQ
    204         ;Check input
    205         I '$G(IEN) Q ""
    206         S DIC=52,DR="116",DA=IEN,DIQ="ECXDIQ"
    207         D DIQ^PSODI(DIC,DIC,DR,DA,DIQ)
    208         Q $S($G(ECXDIQ(52,DA,116))="YES":"Y",$G(ECXDIQ(52,DA,116))="NO":"N",1:"")
    209         ;
    210 SSN(SSN,FILE)   ; extended validation of ssn
    211         ;       input:     ssn - social security number to validate
    212         ;                  file - optional "", 2 or 67, the only check is for
    213         ;                         reference lab file (#67) in which case ssn
    214         ;                         "000123456" is considered a valid ssn.
    215         ;        output:   0 - test patient or invalid ssn
    216         ;                  1 - valid ssn
    217         ;
    218         ;check input
    219         I $G(SSN)']"" Q 0
    220         S FILE=$G(FILE)
    221         I (FILE=67)&(SSN="000123456") Q 1
    222         I "89"[$E(SSN) Q 0
    223         I (SSN="123456789")!(SSN="111111111")!(SSN="222222222")!(SSN="333333333")!(SSN="444444444")!(SSN="555555555")!($E(SSN,1,3)="666")!($E(SSN,4,5)="00")!($E(SSN,1,3)="000") Q 0
    224         Q 1
     1ECXUTL5 ;ALB/JRC - Utilities for DSS Extracts ; 01/18/07 9:04am
     2 ;;3.0;DSS EXTRACTS;**71,84,92,103**;Dec 22, 1997;Build 1
     3 ;
     4REPEAT(CHAR,TIMES) ;REPEAT A STRING
     5 ;INPUT  : CHAR - Character to repeat
     6 ;         TIMES - Number of times to repeat CHAR
     7 ;OUTPUT : s - String of CHAR that is TIMES long
     8 ;         "" - Error (bad input)
     9 ;
     10 ;CHECK INPUT
     11 Q:($G(CHAR)="") ""
     12 Q:((+$G(TIMES))=0) ""
     13 ;RETURN STRING
     14 Q $TR($J("",TIMES)," ",CHAR)
     15INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;INSERT A STRING INTO ANOTHER
     16 ;INPUT  : INSTR - String to insert
     17 ;         OUTSTR - String to insert into
     18 ;         COLUMN - Where to begin insertion (defaults to end of OUTSTR)
     19 ;         LENGTH - Number of characters to clear from OUTSTR
     20 ;                  (defaults to length of INSTR)
     21 ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
     22 ;             using LENGTH characters
     23 ;         "" - Error (bad input)
     24 ;
     25 ;NOTE : This module is based on $$SETSTR^VALM1
     26 ;
     27 ;CHECK INPUT
     28 Q:('$D(INSTR)) ""
     29 Q:('$D(OUTSTR)) ""
     30 S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
     31 S:('$D(LENGTH)) LENGTH=$L(INSTR)
     32 ;DECLARE VARIABLES
     33 N FRONT,END
     34 S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
     35 S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
     36 ;INSERT STRING
     37 Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
     38TYPE(DFN) ;Determine patient type DBIA #2511
     39 ;   input
     40 ;   DFN = patient ien
     41 ;
     42 ;   output
     43 ;   ECXPTYPE = patient type external value from fle 391
     44 ;
     45 ;          AC = ACTIVE DUTY        MI = MILITARY RETIREE
     46 ;          AL = ALLIED VETERAN     NO = NON-VETERAN (OTHER)
     47 ;          CO = COLLATERAL         NS = NSC VETERAN
     48 ;          EM = EMPLOYEE           SC = SC VETERAN
     49 ;          IN = INELIGIBLE         TR = TRICARE
     50 ;          return value 0 if no data found, 1 if data found
     51 ;
     52 N TYPE,ECXPTYPE
     53 ;Check input
     54 Q:'$D(DFN) ""
     55 S (TYPE,ECXPTYPE)=""
     56 S TYPE=$G(^DPT(DFN,"TYPE"))
     57 I 'TYPE Q ECXPTYPE
     58 S ECXPTYPE=$P($G(^DG(391,TYPE,0)),U,1)
     59 S ECXPTYPE=$E(ECXPTYPE,1,2)
     60 Q ECXPTYPE
     61CVEDT(DFN,DATE) ;Determine patient CV status DBIA #4156
     62 ;   input
     63 ;   DFN = patient ien
     64 ;
     65 ;   output
     66 ;   ECXCVE = combat veteran status eligibility
     67 ;   ECXCVEDT = combat veteran eligibility end date
     68 ;   ECXCVENC = combat veteran encounter
     69 ;Initialize variables
     70 N CVSTAT
     71 S (CVSTAT,ECXCVE,ECXCVEDT,ECXCVENC)=""
     72 ;Check input
     73 Q:'$D(DFN) 0
     74 ;Call CV API
     75 S CVSTAT=$$CVEDT^DGCV(DFN,DATE)
     76 I CVSTAT<1 Q 0
     77 ;Veteran been given CV eligibility
     78 S ECXCVE=$S($P(CVSTAT,U,3)=1:"Y",$P(CVSTAT,U,3)=0:"E",1:"")
     79 ;Save CV eligibility end date and convert from FM to HL7 format
     80 S ECXCVEDT=$P(CVSTAT,U,2)
     81 S ECXCVEDT=$$FMTHL7^XLFDT(ECXCVEDT)
     82 ;Is the veteran eligible for CV in the date of encounter
     83 S ECXCVENC=$S($P(CVSTAT,U,3)=1:"Y",1:"")
     84 Q 1
     85NPRF ;National patient record flags DBIA #3860
     86 N ECXARR,FLG
     87 S ECXNPRFI="",CNT=$$GETACT^DGPFAPI(ECXDFN,"ECXARR"),FLG=""
     88 I 'CNT Q
     89 F I=1:1:CNT D  Q:FLG
     90 .I ECXARR(I,"CATEGORY")["NATIONAL" S ECXNPRFI="Y",FLG=1
     91 Q
     92RXPTST(K) ;Rx patient status DBIA #2511
     93 N ECXDIC,STAT
     94 S (ECXDIC,STAT)=""
     95 ;Check input
     96 Q:'$D(K) STAT
     97 S DA=K,DIC="^PS(53,",DIQ(0)="I",DIQ="ECXDIC",DR="6"
     98 D EN^DIQ1
     99 S STAT=$G(ECXDIC(53,K,6,"I"))
     100 S STAT=$S(STAT=1:"SC",STAT=2:"AA",STAT=3:"OTH",STAT=4:"INP",STAT=5:"NON",1:"")
     101 Q STAT
     102NONVAP(K) ;Non-va prescriber DBIA #10060
     103 N ECXDIC,NONVAP
     104 S (ECXDIC,NONVAP)=""
     105 Q:'$D(K) NONVAP
     106 S DA=K,DIC="^VA(200,",DIQ(0)="I",DIQ="ECXDIC",DR="53.91"
     107 D EN^DIQ1
     108 S NONVAP=$G(ECXDIC(200,K,53.91,"I"))
     109 I NONVAP S NONVAP="Y"
     110 Q NONVAP
     111DOIVPO(K,L) ;Add destination for outpatient ivp orders
     112 ;     Input     K - DFN
     113 ;               L - Order # from Pharmacy Patient File (#55)
     114 ;
     115 ;     Output     ordering stop code
     116 ;
     117 N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
     118 S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
     119 ;Check input
     120 Q:'K!'(L) SCODE
     121 ;Check treating specialty
     122 S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
     123 ;Go to pharmacy patient file (#55) and return value of field (#136)
     124 S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="100",DR(55.01)="136",DA=K,DA(55.01)=L
     125 D EN^DIQ1
     126 S CLINIC=$G(ECXDIC(55.01,L,136,"I"))
     127 I 'CLINIC Q SCODE
     128 ;Get stop code pointer to file 40.7 from file 44
     129 S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
     130 S SCODE=ECXDICA(44,CLINIC,8,"I")
     131 ;Get stop code external value
     132 S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
     133 S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
     134 Q SCODE
     135 ;
     136DOUDO(K,L) ;Add destination for outpatient udp orders
     137 ;     Input     K - DFN
     138 ;               L - Order # from Pharmacy Patient File (#55)
     139 ;
     140 ;     Output     ordering stop code
     141 ;
     142 N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
     143 S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
     144 ;Check treating specialty
     145 S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
     146 ;Check input
     147 Q:'K!'(L) SCODE
     148 S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="62",DR(55.06)="130",DA=K,DA(55.06)=L
     149 D EN^DIQ1
     150 S CLINIC=$G(ECXDIC(55.06,L,130,"I"))
     151 I 'CLINIC Q SCODE
     152 ;Get stop code pointer to file 40.7 from file 44
     153 S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
     154 S SCODE=ECXDICA(44,CLINIC,8,"I")
     155 ;Get stop code external value
     156 S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
     157 S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
     158 Q SCODE
     159 ;
     160PHAAPI(DRUG) ;Call Pharmacy drug file API dbia 4483
     161 ;   Input: drug file (#50) ien
     162 ;
     163 ;   Output: generic name ^ classification ^ ndc ^ dea hand
     164 ;            ^ ndf file entry # ^ psndf va product entry ^
     165 ;            price per disp unit ^ dispense unit
     166 ;
     167 ;Initialize variables and scratch global
     168 N NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,UNIT,ARRAY,DATA
     169 S (NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,ARRAY,DATA)=""
     170 S ARRAY="^TMP($J,""ECXLIST"")"
     171 K @ARRAY
     172 D DATA^PSS50(DRUG,,,,,"ECXLIST")
     173 I @ARRAY@(0)'>0 Q "^^^^^^"
     174 S NAME=@ARRAY@(DRUG,.01),CLASS=@ARRAY@(DRUG,2),NDC=@ARRAY@(DRUG,31)
     175 S INV=@ARRAY@(DRUG,3),P1=$P(@ARRAY@(DRUG,20),U),P3=$P(@ARRAY@(DRUG,22),U),PPDU=@ARRAY@(DRUG,16),UNIT=@ARRAY@(DRUG,14.5)
     176 K @ARRAY
     177 Q NAME_U_CLASS_U_NDC_U_INV_U_P1_U_P3_U_PPDU_U_UNIT
     178 ;
     179TSSC(X) ;Check treating specialty (ts) and if ts equals any of the following
     180 ;18,23,24,36,41,65,94 then assign predefined code and return value
     181 ;
     182 ;    Input: treating specialty
     183 ;    Output: Ordering stop code
     184 ;
     185 S CODE=$S(X=18:293,X=23:295,X=24:290,X=36:294,X=41:296,X=65:291,X=94:292,1:"")
     186 Q CODE
     187 ;
     188PSJ59P5(X) ;Get iv room division
     189 ;   Input  X - iv room ien
     190 ;
     191 ;   Output - field .02 division
     192 ;Init variables
     193 N DIV S DIV=""
     194 ;Check input
     195 I 'X  Q DIV
     196 D ALL^PSJ59P5(X,,"ECXDIV")
     197 S DIV=$P($G(^TMP($J,"ECXDIV",X,.02)),U)
     198 K ^TMP($J,"ECXDIV")
     199 Q DIV
     200 ;
     201SCRX(IEN) ;Service connected prescription
     202 ;Init variables
     203 N DIC,DR,DA,ECXDIQ
     204 ;Check input
     205 I '$G(IEN) Q ""
     206 S DIC=52,DR="116",DA=IEN,DIQ="ECXDIQ"
     207 D DIQ^PSODI(DIC,DIC,DR,DA,DIQ)
     208 Q $S($G(ECXDIQ(52,DA,116))="YES":"Y",$G(ECXDIQ(52,DA,116))="NO":"N",1:"")
Note: See TracChangeset for help on using the changeset viewer.