| 1 | ALPBUTL ;OIFO-DALLAS MW,SED,KC-BCMA BCBU REPORT FUNCTIONS AND UTILITIES ;01/01/03
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
|
|---|
| 3 | ;
|
|---|
| 4 | DEFPRT() ; fetch and return default printer...
|
|---|
| 5 | ; returns default printer entry from Device file based on entry in
|
|---|
| 6 | ; DEFAULT MAR PRINTER field in BCMA BACKUP PARAMETERS file (53.71)
|
|---|
| 7 | N X
|
|---|
| 8 | S X=+$O(^ALPB(53.71,0))
|
|---|
| 9 | I X=0 Q ""
|
|---|
| 10 | Q $P($G(^%ZIS(1,+$P(^ALPB(53.71,X,0),"^",3),0)),U)
|
|---|
| 11 | ;
|
|---|
| 12 | DEFDAYS() ; fetch and return default days for MAR printing...
|
|---|
| 13 | ; returns default number of days to print MARs based on entry in
|
|---|
| 14 | ; DEFAULT DAYS FOR MAR field in BCMA BACKUP PARAMETERS file (53.71)
|
|---|
| 15 | ; if null or undefined, returns default of 3 (days)
|
|---|
| 16 | N X
|
|---|
| 17 | S X=+$O(^ALPB(53.71,0))
|
|---|
| 18 | I X=0 Q 7
|
|---|
| 19 | Q +$P(^ALPB(53.71,X,0),"^",2)
|
|---|
| 20 | ;
|
|---|
| 21 | MLRANGE(IEN) ; find first and last Med Log entries' date/time...
|
|---|
| 22 | ; IEN = patient's record number in file 53.7
|
|---|
| 23 | ; returns a delimited string = first Med Log date/time^last Med Log date/time
|
|---|
| 24 | N FIRST,LAST
|
|---|
| 25 | S FIRST=$O(^ALPB(53.7,IEN,"AMLOG",""))
|
|---|
| 26 | I FIRST="" Q "^"
|
|---|
| 27 | S FIRST=FIRST\1
|
|---|
| 28 | S LAST=$O(^ALPB(53.7,IEN,"AMLOG",""),-1)
|
|---|
| 29 | I LAST'="" S LAST=LAST\1
|
|---|
| 30 | I FIRST=LAST Q FIRST_"^"
|
|---|
| 31 | Q FIRST_"^"_LAST
|
|---|
| 32 | ;
|
|---|
| 33 | PAD(STRING,SPACES) ; pad a string...
|
|---|
| 34 | ; STRING = a string passed by reference
|
|---|
| 35 | ; SPACES = number of spaces to concatenate onto STRING
|
|---|
| 36 | ; returns STRING padded with SPACES number of blank spaces
|
|---|
| 37 | N I,RESULT
|
|---|
| 38 | I $G(STRING)="" S STRING=" "
|
|---|
| 39 | I $G(SPACES)="" Q STRING
|
|---|
| 40 | S RESULT=STRING F I=$L(RESULT):1:SPACES S RESULT=RESULT_" "
|
|---|
| 41 | Q RESULT
|
|---|
| 42 | ;
|
|---|
| 43 | FDAYS(START,DAYS,SPACE) ; format a sequence of DAYS beginning with START separated by SPACE...
|
|---|
| 44 | ; START = a date in FileMan internal format from which the formatted string will start
|
|---|
| 45 | ; DAYS = the number of consecutive days to return in the formatted string
|
|---|
| 46 | ; SPACE = the number of spaces between each number in the formatted string
|
|---|
| 47 | ; (if not passed, defaults to 4 spaces)
|
|---|
| 48 | ; returns a formatted string (example: 1 2 3)
|
|---|
| 49 | N DIM,I,J,RESULT,TODAY
|
|---|
| 50 | I $G(START)=""!($G(DAYS)="") Q ""
|
|---|
| 51 | I $G(SPACE)="" S SPACE=4
|
|---|
| 52 | S (RESULT,TODAY)=+$E(START,6,7)
|
|---|
| 53 | F I=1:1:SPACE S RESULT=RESULT_" "
|
|---|
| 54 | S DIM=$$DIM(START)
|
|---|
| 55 | F I=DAYS-1:-1:1 D
|
|---|
| 56 | .S TODAY=TODAY+1
|
|---|
| 57 | .I TODAY>DIM S TODAY=1
|
|---|
| 58 | .S RESULT=RESULT_$S(TODAY<10:"0"_TODAY,1:TODAY)
|
|---|
| 59 | .I I>1 D
|
|---|
| 60 | ..F J=1:1:SPACE S RESULT=RESULT_" "
|
|---|
| 61 | Q RESULT
|
|---|
| 62 | ;
|
|---|
| 63 | FMONS(START,DAYS,SPACE) ; format a sequence of months given a START date separated by SPACE...
|
|---|
| 64 | ; START = a date in FileMan internal format the month of which will be the string starting point
|
|---|
| 65 | ; DAYS = the number of days that will be displayed
|
|---|
| 66 | ; SPACE = the number of spaces between each month (defaults to 1 space)
|
|---|
| 67 | ; returns a string equal to the month or months depending upon the number of days passed
|
|---|
| 68 | ; for example: if START=3021031 (Oct 31, 2002) and DAYS=3 then two month names will be
|
|---|
| 69 | ; returned: OCT NOV
|
|---|
| 70 | N DIM,I,J,MON,MON1,NEXTMON,RESULT,TODAY,XSPACE
|
|---|
| 71 | I $G(START)=""!($G(DAYS)="") Q ""
|
|---|
| 72 | I $G(SPACE)="" S SPACE=4
|
|---|
| 73 | S (XSPACE,XSTRIP)=""
|
|---|
| 74 | F I=1:1:SPACE+1 S XSPACE=XSPACE_"*",XSTRIP=XSTRIP_" "
|
|---|
| 75 | S DIM=$$DIM(START),TODAY=+$E(START,6,7),MON1=+$E(START,4,5)
|
|---|
| 76 | S (RESULT,MON)=$$MONN(MON1)
|
|---|
| 77 | I (TODAY+DAYS)<DIM!(TODAY+DAYS=DIM) Q RESULT
|
|---|
| 78 | F I=1:1:DAYS D
|
|---|
| 79 | .S RESULT=RESULT_XSPACE
|
|---|
| 80 | .S TODAY=TODAY+1
|
|---|
| 81 | .I TODAY<DIM!(TODAY=DIM) Q
|
|---|
| 82 | .S MON1=MON1+1
|
|---|
| 83 | .I MON1>12 S MON1=1
|
|---|
| 84 | .S MON=$$MONN(MON1),RESULT=RESULT_MON
|
|---|
| 85 | .S DIM=$$DIM($E(START,1,3)_$S(MON1<10:"0"_MON1,1:MON1)),TODAY=0
|
|---|
| 86 | F I=$L(RESULT):-1 Q:$E(RESULT,I)'="*"!(I=0)
|
|---|
| 87 | S RESULT=$E(RESULT,1,I),RESULT=$TR(RESULT,XSPACE,XSTRIP)
|
|---|
| 88 | Q RESULT
|
|---|
| 89 | ;
|
|---|
| 90 | FDATES(START,DAYS,RESULTS) ;
|
|---|
| 91 | N I,X,X1,X2
|
|---|
| 92 | S RESULTS(0)=" "_$E(START,4,5)_"/"_$E(START,6,7)_" ",RESULTS(1)=START
|
|---|
| 93 | F I=1:1:DAYS-1 D
|
|---|
| 94 | .S X1=START,X2=I
|
|---|
| 95 | .D C^%DTC
|
|---|
| 96 | .S RESULTS(I+1)=X,RESULTS(0)=RESULTS(0)_" "_$E(X,4,5)_"/"_$E(X,6,7)_" "
|
|---|
| 97 | .K X,X1,X2
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | DIM(X) ; number of days in a specified month...
|
|---|
| 101 | ; X = a date in internal FileMan format (can be partial: YYYMM)
|
|---|
| 102 | ; returns a number representing the number of days in month X
|
|---|
| 103 | I $G(X)="" Q 0
|
|---|
| 104 | N DAYS,MON,YEAR
|
|---|
| 105 | S MON=+$E(X,4,5)
|
|---|
| 106 | I MON<1 Q 0
|
|---|
| 107 | S DAYS=$S(MON=1:31,MON=2:28,MON=3:31,MON=4:30,MON=5:31,MON=6:30,MON=7:31,MON=8:31,MON=9:30,MON=10:31,MON=11:30,MON=12:31,1:0)
|
|---|
| 108 | ; if passed date is in Feb, check for leap year and adjust days if needed...
|
|---|
| 109 | I MON=2 D
|
|---|
| 110 | .S YEAR=+$E(X,1,3)+1700
|
|---|
| 111 | .I $$LEAP^XLFDT2(YEAR) S DAYS=29
|
|---|
| 112 | Q DAYS
|
|---|
| 113 | ;
|
|---|
| 114 | MONN(X) ; month name...
|
|---|
| 115 | ; X = month number (1-12)
|
|---|
| 116 | ; returns name of month specified in X
|
|---|
| 117 | I $G(X)="" Q ""
|
|---|
| 118 | S X=+X
|
|---|
| 119 | Q $S(X=1:"JAN",X=2:"FEB",X=3:"MAR",X=4:"APR",X=5:"MAY",X=6:"JUN",X=7:"JUL",X=8:"AUG",X=9:"SEP",X=10:"OCT",X=11:"NOV",X=12:"DEC",1:"")
|
|---|
| 120 | ;
|
|---|
| 121 | FDATE(X) ; special format for a FileMan date/time...
|
|---|
| 122 | ; X = date and time (time is optional) in FileMan format
|
|---|
| 123 | ; returns the FileMan date/time in the format MM/DD/YY@HH:MM
|
|---|
| 124 | N DATE,FMDATE
|
|---|
| 125 | S DATE=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|---|
| 126 | S FMDATE=$$FMTE^XLFDT(X)
|
|---|
| 127 | I $P(FMDATE,"@",2)'="" S DATE=DATE_"@"_$P($P(FMDATE,"@",2),":")_":"_$P($P(FMDATE,"@",2),":",2)
|
|---|
| 128 | Q DATE
|
|---|
| 129 | ;
|
|---|
| 130 | WARDLIST(DTYPE) ; list of wards on file...
|
|---|
| 131 | ; DTYPE = 'C' for vertical (columnar) list
|
|---|
| 132 | ; 'L' for horizontal list
|
|---|
| 133 | I $G(DTYPE)="" S DTYPE="L"
|
|---|
| 134 | N ALPBWARD
|
|---|
| 135 | W !,"Wards with BCMA Backup Data on this workstation:",!
|
|---|
| 136 | S ALPBWARD=""
|
|---|
| 137 | F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
|
|---|
| 138 | .I DTYPE="L" D Q
|
|---|
| 139 | ..I $X+$L(ALPBWARD)>IOM W !
|
|---|
| 140 | ..W ALPBWARD
|
|---|
| 141 | ..I $O(^ALPB(53.7,"AW",ALPBWARD))'="" W ", "
|
|---|
| 142 | .W !?5,ALPBWARD
|
|---|
| 143 | Q
|
|---|
| 144 | ;
|
|---|
| 145 | WARDSEL(WARD,RESULTS) ; find a selected ward...
|
|---|
| 146 | ; WARD = a string representing a ward input by the user
|
|---|
| 147 | ; RESULTS = an array passed by reference in which possible matches are stored
|
|---|
| 148 | ; returns possible matches for the WARD in RESULTS
|
|---|
| 149 | N ALPBWARD,ALPBX
|
|---|
| 150 | S RESULTS(0)=0
|
|---|
| 151 | S ALPBWARD=""
|
|---|
| 152 | F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
|
|---|
| 153 | .I ALPBWARD=WARD D Q
|
|---|
| 154 | ..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
|
|---|
| 155 | .I ALPBWARD[WARD D
|
|---|
| 156 | ..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
|
|---|
| 157 | ; if a straight lookup failed, let's try making any alphas
|
|---|
| 158 | ; entered by the user uppercase and try it once more...
|
|---|
| 159 | I RESULTS(0)=0 D
|
|---|
| 160 | .S WARD=$$UP^XLFSTR(WARD)
|
|---|
| 161 | .S ALPBWARD=""
|
|---|
| 162 | .F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
|
|---|
| 163 | ..I ALPBWARD=WARD D Q
|
|---|
| 164 | ...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
|
|---|
| 165 | ..I ALPBWARD[WARD D
|
|---|
| 166 | ...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| 169 | OTYP(CODE) ; expand order type for printing...
|
|---|
| 170 | ; CODE = a character representing an order type
|
|---|
| 171 | ; returns expanded order type from ^DD(53.79,6,0)
|
|---|
| 172 | I $G(CODE)="" Q ""
|
|---|
| 173 | Q $S(CODE="U":"UNIT DOSE",CODE="V":"IV",CODE="P":"PENDING",1:CODE)
|
|---|
| 174 | ;
|
|---|
| 175 | ORDS(IEN,DATE,RESULTS) ; retrieve orders for a given patient...
|
|---|
| 176 | ; IEN = patient's record number in file 53.7
|
|---|
| 177 | ; DATE = the date/time used to determine whether all or only current
|
|---|
| 178 | ; orders are returned:
|
|---|
| 179 | ; >passed as a date/time in FileMan internal format -- only orders
|
|---|
| 180 | ; with a stop date/time equal to or greater than DATE are returned
|
|---|
| 181 | ; >passed = "" then all orders are returned regardless of status
|
|---|
| 182 | ; returns RESULTS(order# ien) -- note: RESULTS(0)=count of active orders
|
|---|
| 183 | I +$G(IEN)=0 S RESULTS(0)=0 Q
|
|---|
| 184 | N ALPBX,ALPBY,ORDERDAT,ORDERIEN,ORDERST
|
|---|
| 185 | S (ORDERIEN,RESULTS(0))=0
|
|---|
| 186 | F S ORDERIEN=$O(^ALPB(53.7,IEN,2,ORDERIEN)) Q:'ORDERIEN D
|
|---|
| 187 | .S ORDERDAT(0)=$G(^ALPB(53.7,IEN,2,ORDERIEN,0))
|
|---|
| 188 | .S ORDERDAT(1)=$G(^ALPB(53.7,IEN,2,ORDERIEN,1))
|
|---|
| 189 | .S ORDERDAT(3)=$G(^ALPB(53.7,IEN,2,ORDERIEN,3))
|
|---|
| 190 | .S ORDERDAT(4)=$G(^ALPB(53.7,IEN,2,ORDERIEN,4))
|
|---|
| 191 | .S ORDERST=$P($P(ORDERDAT(0),"^",3),"~")
|
|---|
| 192 | .; is this order current?...
|
|---|
| 193 | .I $G(DATE)'=""&($P(ORDERDAT(1),"^",2)<$G(DATE)) K ORDERDAT Q
|
|---|
| 194 | .; if current, is it still active?...
|
|---|
| 195 | .I $G(DATE)'=""&(ORDERST'="CM")&(ORDERST'="ZS")&(ORDERST'="ZU") K ORDERDAT Q
|
|---|
| 196 | .S RESULTS(0)=RESULTS(0)+1
|
|---|
| 197 | .S RESULTS(ORDERIEN)=$P(ORDERDAT(0),"^")
|
|---|
| 198 | .S RESULTS("B",$P(ORDERDAT(0),"^"))=ORDERIEN
|
|---|
| 199 | .S RESULTS(ORDERIEN,1)=$S($P(ORDERDAT(3),"^")="V":"IV",$P(ORDERDAT(3),"^")="U":"UD",1:$P(ORDERDAT(3),"^"))
|
|---|
| 200 | .S RESULTS(ORDERIEN,2)=ORDERST
|
|---|
| 201 | .S RESULTS(ORDERIEN,3,0)=0
|
|---|
| 202 | .;S RESULTS(ORDERIEN,4)=$P($G(ORDERDAT(4)),"^",3)
|
|---|
| 203 | .S RESULTS(ORDERIEN,4)=$G(ORDERDAT(4))
|
|---|
| 204 | .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,7,0)) D
|
|---|
| 205 | ..S ALPBX=0
|
|---|
| 206 | ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,7,ALPBX)) Q:'ALPBX D
|
|---|
| 207 | ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
|
|---|
| 208 | ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,7,ALPBX,0),"^",2)
|
|---|
| 209 | ...S RESULTS(ORDERIEN,3,0)=ALPBY
|
|---|
| 210 | .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,8,0)) D
|
|---|
| 211 | ..S ALPBX=0
|
|---|
| 212 | ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,8,ALPBX)) Q:'ALPBX D
|
|---|
| 213 | ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
|
|---|
| 214 | ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,8,ALPBX,0),"^",2)_" (Additive)"
|
|---|
| 215 | ...S RESULTS(ORDERIEN,3,0)=ALPBY
|
|---|
| 216 | .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,9,0)) D
|
|---|
| 217 | ..S ALPBX=0
|
|---|
| 218 | ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,9,ALPBX)) Q:'ALPBX D
|
|---|
| 219 | ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
|
|---|
| 220 | ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,9,ALPBX,0),"^",2)_" (Solution)"
|
|---|
| 221 | ...S RESULTS(ORDERIEN,3,0)=ALPBY
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | DELPT(IEN) ; delete a patient's entire record...
|
|---|
| 225 | ; IEN = patient's record number in file 53.7
|
|---|
| 226 | N DA,DIK,X,Y
|
|---|
| 227 | S DA=IEN,DIK="^ALPB(53.7,"
|
|---|
| 228 | D ^DIK
|
|---|
| 229 | ; after deleting the patient, check for any error log
|
|---|
| 230 | ; entries and delete them...
|
|---|
| 231 | D CLEAN^ALPBUTL1(IEN)
|
|---|
| 232 | Q
|
|---|
| 233 | ;
|
|---|
| 234 | DELORD(IEN,OIEN) ; delete an order from a patient's record...
|
|---|
| 235 | ; IEN = patient's record number in file 53.7
|
|---|
| 236 | ; OIEN = order number's record number
|
|---|
| 237 | N DA,DIK,X,Y
|
|---|
| 238 | S DA=OIEN,DA(1)=IEN,DIK="^ALPB(53.7,"_DA(1)_",2,"
|
|---|
| 239 | D ^DIK
|
|---|
| 240 | Q
|
|---|
| 241 | ;
|
|---|
| 242 | STATUS ; return last update date/time and count of any errors...
|
|---|
| 243 | N ALPBCNT,ALPBPARM
|
|---|
| 244 | S ALPBPARM=+$O(^ALPB(53.71,0))
|
|---|
| 245 | I ALPBPARM=0 W !,"NOTICE! There is no entry in the BCMA BACKUP PARAMETERS FILE!" Q
|
|---|
| 246 | W !,"BCMA Backup System was last updated: ",$S($P($G(^ALPB(53.71,ALPBPARM,2)),"^")'="":$$FMTE^XLFDT($P(^ALPB(53.71,ALPBPARM,2),"^")),1:"UNKNOWN")
|
|---|
| 247 | S ALPBCNT=$$ERRCT^ALPBUTL2()
|
|---|
| 248 | I ALPBCNT>0 W !,"NOTICE! ",ALPBCNT_" filing error"_$S(ALPBCNT=1:" has",1:"s have")_" been logged."
|
|---|
| 249 | Q
|
|---|
