[623] | 1 | ALPBUTL1 ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES ;01/01/03
|
---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
|
---|
| 3 | ;
|
---|
| 4 | ; Reference/IA
|
---|
| 5 | ; INP^VADPT/10061
|
---|
| 6 | ; DIC(42/10039
|
---|
| 7 | ; DIC(42/2440
|
---|
| 8 | ;
|
---|
| 9 | ERRBLD(SEG,MSG,ERR) ; build an error array for non-FileMan-related errors...
|
---|
| 10 | ; SEG = HL7 segment name
|
---|
| 11 | ; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
|
---|
| 12 | ; default will be used)
|
---|
| 13 | ; ERR = array passed by reference in which error will be returned
|
---|
| 14 | ; note: code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
|
---|
| 15 | S ERR("DIERR")=1
|
---|
| 16 | S ERR("DIERR",1)=999
|
---|
| 17 | S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
|
---|
| 21 | ; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71). These
|
---|
| 22 | ; errors usually occur as the result of missing or bad data passed to one of the
|
---|
| 23 | ; File Manager DBS calls used by this package.
|
---|
| 24 | ;
|
---|
| 25 | ; IEN = the patient's record number in file 53.7
|
---|
| 26 | ; OIEN = the order number's sub-file record number in file 53.7
|
---|
| 27 | ; MSGREC = the HL7 message's record number in file 772
|
---|
| 28 | ; SEGNAME = the HL7 segment associated with the error (optional)
|
---|
| 29 | ; SEGDATA = the HL7 segment's data (optional)
|
---|
| 30 | ; ERRTEXT = an array passed by reference which contains the error
|
---|
| 31 | ; code (numeric) and the error text to be filed. It is
|
---|
| 32 | ; expected that this is usually the error array returned
|
---|
| 33 | ; from a FileMan DBS call, so the format is specific:
|
---|
| 34 | ;
|
---|
| 35 | ; ERRTEXT("DIERR",n)=error code (numeric)
|
---|
| 36 | ; ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
|
---|
| 37 | ; ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
|
---|
| 38 | ; ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
|
---|
| 39 | ;
|
---|
| 40 | ; However, any error message can be passed to this module
|
---|
| 41 | ; as long as the above format is used.
|
---|
| 42 | N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
|
---|
| 43 | S ALPBLOGD=$$NOW^XLFDT()
|
---|
| 44 | S ALPBPIEN=+$O(^ALPB(53.71,0))
|
---|
| 45 | I ALPBPIEN=0 D
|
---|
| 46 | .S X="ONE"
|
---|
| 47 | .S DIC="^ALPB(53.71,"
|
---|
| 48 | .S DIC(0)="LZ"
|
---|
| 49 | .S DIC("DR")="1///^S X=3"
|
---|
| 50 | .S DINUM=1
|
---|
| 51 | .S DLAYGO=53.71
|
---|
| 52 | .D FILE^DICN K DIC
|
---|
| 53 | .S ALPBPIEN=+Y
|
---|
| 54 | I ALPBPIEN'>0 Q
|
---|
| 55 | S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
|
---|
| 56 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
|
---|
| 57 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
|
---|
| 58 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
|
---|
| 59 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
|
---|
| 60 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
|
---|
| 61 | S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
|
---|
| 62 | D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
|
---|
| 63 | K ALPBFERR,ALPBFILE
|
---|
| 64 | S ALPBX=0
|
---|
| 65 | F S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX D
|
---|
| 66 | .S ALPBCODE=ERRTEXT("DIERR",ALPBX)
|
---|
| 67 | .; file the error code...
|
---|
| 68 | .S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
|
---|
| 69 | .S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
|
---|
| 70 | .D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
|
---|
| 71 | .K ALPBFERR,ALPBFILE
|
---|
| 72 | .; file the error text...
|
---|
| 73 | .M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
|
---|
| 74 | .D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
|
---|
| 75 | .;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
|
---|
| 76 | .;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
|
---|
| 77 | .K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | CLEAN(IEN) ; check error log records to see if the patients' whose records
|
---|
| 81 | ; are noted still exist in file 53.7. if not, delete the error log
|
---|
| 82 | ; record(s) in file 53.71...
|
---|
| 83 | ; IEN = patient record number in file 53.7
|
---|
| 84 | ; Note: this function is also called from DELPT^ALPBUTL when a patient's
|
---|
| 85 | ; record is deleted (as a result of a discharge action) from 53.7.
|
---|
| 86 | ;
|
---|
| 87 | N ALPBX,ALPBY,DA,DIK,X,Y
|
---|
| 88 | ; patient still has record in 53.7? if so, quit...
|
---|
| 89 | I $G(^ALPB(53.7,IEN,0))'="" Q
|
---|
| 90 | S ALPBX=0
|
---|
| 91 | F S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX D
|
---|
| 92 | .S ALPBY=0
|
---|
| 93 | .F S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY D
|
---|
| 94 | ..S DA=ALPBY
|
---|
| 95 | ..S DA(1)=ALPBX
|
---|
| 96 | ..S DIK="^ALPB(53.71,"_DA(1)_",1,"
|
---|
| 97 | ..D ^DIK
|
---|
| 98 | ..K DA,DIK
|
---|
| 99 | .K ALPBY
|
---|
| 100 | K ALPBX
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | DELERR(ERRIEN) ; delete an error log entry from file 53.71...
|
---|
| 104 | ; ERRIEN = error log entry's internal record number
|
---|
| 105 | N ALPBPARM,DA,DIK,X,Y
|
---|
| 106 | S ALPBPARM=+$O(^ALPB(53.71,0))
|
---|
| 107 | I ALPBPARM'>0 Q
|
---|
| 108 | S DA=ERRIEN
|
---|
| 109 | S DA(1)=ALPBPARM
|
---|
| 110 | S DIK="^ALPB(53.71,"_DA(1)_",1,"
|
---|
| 111 | D ^DIK
|
---|
| 112 | Q
|
---|
| 113 | ;
|
---|
| 114 | PTLIST(LTYPE,RESULTS) ; get list of patients in file 53.7...
|
---|
| 115 | ; LTYPE = passed = "ALL" to list all patients or
|
---|
| 116 | ; = <wardname> to list patients on a selected ward
|
---|
| 117 | ; RESULTS = an array passed by reference in which data will be returned
|
---|
| 118 | N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
|
---|
| 119 | I $G(LTYPE)="" S LTYPE="ALL"
|
---|
| 120 | S ALPBX=0
|
---|
| 121 | I LTYPE="ALL" D
|
---|
| 122 | .S ALPBPTN=""
|
---|
| 123 | .F S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN="" D
|
---|
| 124 | ..S ALPBIEN=0
|
---|
| 125 | ..F S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
|
---|
| 126 | ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
|
---|
| 127 | ...I ALPBDATA="" K ALPBDATA Q
|
---|
| 128 | ...S ALPBX=ALPBX+1
|
---|
| 129 | ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
|
---|
| 130 | ...K ALPBDATA
|
---|
| 131 | ..K ALPBIEN
|
---|
| 132 | .K ALPBPTN
|
---|
| 133 | I LTYPE'="ALL" D
|
---|
| 134 | .S ALPBPTN=""
|
---|
| 135 | .F S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN="" D
|
---|
| 136 | ..S ALPBIEN=0
|
---|
| 137 | ..F S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
|
---|
| 138 | ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
|
---|
| 139 | ...I ALPBDATA="" K ALPBDATA Q
|
---|
| 140 | ...S ALPBX=ALPBX+1
|
---|
| 141 | ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
|
---|
| 142 | ...K ALPBDATA
|
---|
| 143 | ..K ALPBIEN
|
---|
| 144 | .K ALPBPTN
|
---|
| 145 | Q
|
---|
| 146 | ;
|
---|
| 147 | STAT(ST) ;This will return the value of a status code for pharmacy
|
---|
| 148 | I $G(ST)="" Q ""
|
---|
| 149 | I $L($T(@ST)) G @ST
|
---|
| 150 | Q ""
|
---|
| 151 | IP Q "pending"
|
---|
| 152 | CM Q "finished/verified by pharmacist(active)"
|
---|
| 153 | DC Q "discontinued"
|
---|
| 154 | RP Q "replaced"
|
---|
| 155 | HD Q "on hold"
|
---|
| 156 | ZE Q "expired"
|
---|
| 157 | ZS Q "suspended(active)"
|
---|
| 158 | ZU Q "un-suspended(active)"
|
---|
| 159 | ZX Q "unreleased"
|
---|
| 160 | ZZ Q "renewed"
|
---|
| 161 | ;
|
---|
| 162 | STAT2(CODE) ; convert order status code for output...
|
---|
| 163 | ; this function is used primarily by the workstation software
|
---|
| 164 | ; CODE = an order status code
|
---|
| 165 | ; returns printable status code
|
---|
| 166 | I $G(CODE)="" Q "Unknown"
|
---|
| 167 | I CODE="IP"!(CODE="ZX") Q "Pending"
|
---|
| 168 | I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
|
---|
| 169 | I CODE="HD"!(CODE="ZS") Q "Hold"
|
---|
| 170 | I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
|
---|
| 171 | Q "Unknown"
|
---|
| 172 | ;
|
---|
| 173 | DIV(DFN,ALPBMDT) ;get the Division for a patient
|
---|
| 174 | I +$G(DFN)'>0 Q ""
|
---|
| 175 | N ALPBDIV,ALPWRD,VAIN,VAINDT
|
---|
| 176 | S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
|
---|
| 177 | K ALPBMDT
|
---|
| 178 | D INP^VADPT
|
---|
| 179 | S ALPWRD=$P($G(VAIN(4)),U,1)
|
---|
| 180 | Q:+ALPWRD'>0 ""
|
---|
| 181 | ;Check to see if ward is a DOMICILIARY
|
---|
| 182 | I $P($G(^DIC(42,ALPWRD,0)),U,3)="D" Q "DOM"
|
---|
| 183 | S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
|
---|
| 184 | Q:+ALPBDIV'>0 ""
|
---|
| 185 | Q ALPBDIV
|
---|
| 186 | ;
|
---|
| 187 | CNV(A,B,X) ;CONVERT A STRING
|
---|
| 188 | ;This API will take a HL7 segment and convert characters
|
---|
| 189 | ;defined in the input
|
---|
| 190 | ;Example:
|
---|
| 191 | ;Single encoding characters can be converted such as ^ to ~
|
---|
| 192 | ;or multiple encoding characters can be converted such as
|
---|
| 193 | ; |~^@/ to ^~|/@
|
---|
| 194 | ;A is the string of HL7 encoding characters to be converted
|
---|
| 195 | ;B is the string of HL7 encoding characters to be converted to
|
---|
| 196 | ;X is te message string to be converted
|
---|
| 197 | I A=""!B=""!X="" Q ""
|
---|
| 198 | F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
|
---|
| 199 | F I=1:1:$L(B) S B(I)=$E(B,I,I)
|
---|
| 200 | S J=0
|
---|
| 201 | F S J=$O(A(J)) Q:+J'>0 D
|
---|
| 202 | . F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
|
---|
| 203 | S J=0
|
---|
| 204 | F S J=$O(A(J)) Q:+J'>0 D
|
---|
| 205 | . Q:'$D(A(J,1))!'$D(B(J))
|
---|
| 206 | . F I=1:1:$L(A(J,1),U) S C=$P(A(J,1),U,I) S:+C>0 $E(X,C,C)=B(J)
|
---|
| 207 | Q X
|
---|