| 1 | ALPBUTL2 ;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 | DELALG(IEN) ; delete allergies...
|
|---|
| 5 | ; IEN = the patient's record number in file 53.7
|
|---|
| 6 | ; deletes any allergies in the patient's record -- returns nothing
|
|---|
| 7 | I +$G(IEN)=0 Q
|
|---|
| 8 | I +$O(^ALPB(53.7,IEN,1,0))=0 Q
|
|---|
| 9 | N ALPBX,DA,DIK,X,Y
|
|---|
| 10 | S ALPBX=0
|
|---|
| 11 | F S ALPBX=$O(^ALPB(53.7,IEN,1,ALPBX)) Q:'ALPBX D
|
|---|
| 12 | .S DA=ALPBX
|
|---|
| 13 | .S DA(1)=IEN
|
|---|
| 14 | .S DIK="^ALPB(53.7,"_DA(1)_",1,"
|
|---|
| 15 | .D ^DIK
|
|---|
| 16 | .K DA,DIK
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | GETPID(DATA,FS,CS,ECH,RESULTS) ; retrieve specific patient ID data from
|
|---|
| 20 | ; PID segment...
|
|---|
| 21 | ; DATA = HL7 data string
|
|---|
| 22 | ; FS = HL7 field separator character
|
|---|
| 23 | ; CS = HL7 component separator character
|
|---|
| 24 | ; ECH = HL7 separators string
|
|---|
| 25 | ; RESULTS = an array passed by reference into which retrieved data
|
|---|
| 26 | ; is returned patient's DFN
|
|---|
| 27 | S RESULTS(1)=$P($P(DATA,FS,4),CS,1)
|
|---|
| 28 | ; name...
|
|---|
| 29 | S RESULTS(2)=$$FMNAME^HLFNC($P(DATA,FS,6),ECH)
|
|---|
| 30 | ; ssn (strip any dashes)...
|
|---|
| 31 | S RESULTS(3)=$$STRIP^XLFSTR($P($P(DATA,FS,3),CS,1),"-")
|
|---|
| 32 | ; dob...
|
|---|
| 33 | S RESULTS(4)=$$FMDATE^HLFNC($P(DATA,FS,8))
|
|---|
| 34 | ; gender...
|
|---|
| 35 | S RESULTS(5)=$P(DATA,FS,9)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | GETORC(DATA,FS,CS,RESULTS) ; retrieve order number, date, type, and
|
|---|
| 39 | ; CPRS order number from ORC segment...
|
|---|
| 40 | ; DATA = HL7 data string
|
|---|
| 41 | ; FS = HL7 field separator character
|
|---|
| 42 | ; CS = HL7 component separator character
|
|---|
| 43 | ; RESULTS = an array passed by reference into which retrieved data
|
|---|
| 44 | ; is returned order action
|
|---|
| 45 | S RESULTS(0)=$P(DATA,FS,2)
|
|---|
| 46 | ; order number...
|
|---|
| 47 | S RESULTS(1)=$P($P(DATA,FS,4),CS,1)
|
|---|
| 48 | ; order date/time...
|
|---|
| 49 | S RESULTS(2)=$S($P(DATA,FS,16)'="":$$FMDATE^HLFNC($P(DATA,FS,16)),$P(DATA,FS,10)'="":$$FMDATE^HLFNC($P(DATA,FS,10)),1:"")
|
|---|
| 50 | ; CPRS order number...
|
|---|
| 51 | S RESULTS(3)=+$P(DATA,FS,3)
|
|---|
| 52 | ; order type...
|
|---|
| 53 | S RESULTS(4)=$E(RESULTS(1),$L(RESULTS(1)))
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | DELERR(IEN) ; delete an entry from the Error Log...
|
|---|
| 57 | ; IEN = the Error Log record number
|
|---|
| 58 | N ALPBPARM,DA,DIK,X,Y
|
|---|
| 59 | S ALPBPARM=+$O(^ALPB(53.71,0))
|
|---|
| 60 | I ALPBPARM'>0 Q
|
|---|
| 61 | S DA=IEN
|
|---|
| 62 | S DA(1)=ALPBPARM
|
|---|
| 63 | S DIK="^ALPB(53.71,"_DA(1)_",1,"
|
|---|
| 64 | D ^DIK
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ERRCT() ; fetch and return count of errors in the log in BCMA BACKUP PARAMETERS
|
|---|
| 68 | ; file...
|
|---|
| 69 | ; returns count of errors
|
|---|
| 70 | N ALPBPARM,ALPBCNT,ALPBX
|
|---|
| 71 | S ALPBPARM=+$O(^ALPB(53.71,0))
|
|---|
| 72 | I ALPBPARM'>0 Q 0
|
|---|
| 73 | S (ALPBCNT,ALPBX)=0
|
|---|
| 74 | F S ALPBX=$O(^ALPB(53.71,ALPBPARM,1,"B",ALPBX)) Q:'ALPBX S ALPBCNT=ALPBCNT+1
|
|---|
| 75 | Q ALPBCNT
|
|---|
| 76 | ;
|
|---|
| 77 | REPL(X,Y) ; replace non-alpha and non-numeric characters...
|
|---|
| 78 | ; X = a string to examine
|
|---|
| 79 | ; Y = a character to use as the replacment
|
|---|
| 80 | ; returns a string with any non-alpha and non-numeric characters
|
|---|
| 81 | ; converted to the character passed in Y
|
|---|
| 82 | I $G(X)=""!($G(Y)="") Q X
|
|---|
| 83 | N I,NEWSTR,NEWX,Z
|
|---|
| 84 | S NEWSTR=""
|
|---|
| 85 | F I=1:1:$L(X) D
|
|---|
| 86 | .S (NEWX,Z)=$E(X,I)
|
|---|
| 87 | .I $A(Z)<48&($A(Z)'=44) S NEWX=Y
|
|---|
| 88 | .I $A(Z)>57&($A(Z)<65) S NEWX=Y
|
|---|
| 89 | .I $A(Z)>90&($A(Z)<97) S NEWX=Y
|
|---|
| 90 | .I $A(Z)>122 S NEWX=Y
|
|---|
| 91 | .S NEWSTR=NEWSTR_NEWX
|
|---|
| 92 | Q NEWSTR
|
|---|
| 93 | ;
|
|---|
| 94 | CLORD(IEN,OIEN) ; delete drug(s), additive(s) and/or solution(s) entries
|
|---|
| 95 | ; for a specified order...
|
|---|
| 96 | ; IEN = patient's record number in file 53.7
|
|---|
| 97 | ; OIEN = order's sub-record number in file 53.7
|
|---|
| 98 | ; returns nothing
|
|---|
| 99 | I +$G(IEN)=0!(+$G(OIEN)=0) Q
|
|---|
| 100 | N DA,DIK,SUB,X,XIEN,Y
|
|---|
| 101 | F SUB=7,8,9 D
|
|---|
| 102 | .S XIEN=0
|
|---|
| 103 | .F S XIEN=$O(^ALPB(53.7,IEN,2,OIEN,SUB,XIEN)) Q:'XIEN D
|
|---|
| 104 | ..S DA=XIEN
|
|---|
| 105 | ..S DA(1)=OIEN
|
|---|
| 106 | ..S DA(2)=IEN
|
|---|
| 107 | ..S DIK="^ALPB(53.7,"_DA(2)_",2,"_DA(1)_","_SUB_","
|
|---|
| 108 | ..D ^DIK
|
|---|
| 109 | ..K DA,DIK
|
|---|
| 110 | .K XIEN
|
|---|
| 111 | Q
|
|---|
