Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ALPBUTL

ALPBUTL.m

Go to the documentation of this file.
  1. ALPBUTL ;OIFO-DALLAS MW,SED,KC-BCMA BCBU REPORT FUNCTIONS AND UTILITIES ;01/01/03
  1. ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
  1. ;
  1. DEFPRT() ; fetch and return default printer...
  1. ; returns default printer entry from Device file based on entry in
  1. ; DEFAULT MAR PRINTER field in BCMA BACKUP PARAMETERS file (53.71)
  1. N X
  1. S X=+$O(^ALPB(53.71,0))
  1. I X=0 Q ""
  1. Q $P($G(^%ZIS(1,+$P(^ALPB(53.71,X,0),"^",3),0)),U)
  1. ;
  1. DEFDAYS() ; fetch and return default days for MAR printing...
  1. ; returns default number of days to print MARs based on entry in
  1. ; DEFAULT DAYS FOR MAR field in BCMA BACKUP PARAMETERS file (53.71)
  1. ; if null or undefined, returns default of 3 (days)
  1. N X
  1. S X=+$O(^ALPB(53.71,0))
  1. I X=0 Q 7
  1. Q +$P(^ALPB(53.71,X,0),"^",2)
  1. ;
  1. MLRANGE(IEN) ; find first and last Med Log entries' date/time...
  1. ; IEN = patient's record number in file 53.7
  1. ; returns a delimited string = first Med Log date/time^last Med Log date/time
  1. N FIRST,LAST
  1. S FIRST=$O(^ALPB(53.7,IEN,"AMLOG",""))
  1. I FIRST="" Q "^"
  1. S FIRST=FIRST\1
  1. S LAST=$O(^ALPB(53.7,IEN,"AMLOG",""),-1)
  1. I LAST'="" S LAST=LAST\1
  1. I FIRST=LAST Q FIRST_"^"
  1. Q FIRST_"^"_LAST
  1. ;
  1. PAD(STRING,SPACES) ; pad a string...
  1. ; STRING = a string passed by reference
  1. ; SPACES = number of spaces to concatenate onto STRING
  1. ; returns STRING padded with SPACES number of blank spaces
  1. N I,RESULT
  1. I $G(STRING)="" S STRING=" "
  1. I $G(SPACES)="" Q STRING
  1. S RESULT=STRING F I=$L(RESULT):1:SPACES S RESULT=RESULT_" "
  1. Q RESULT
  1. ;
  1. FDAYS(START,DAYS,SPACE) ; format a sequence of DAYS beginning with START separated by SPACE...
  1. ; START = a date in FileMan internal format from which the formatted string will start
  1. ; DAYS = the number of consecutive days to return in the formatted string
  1. ; SPACE = the number of spaces between each number in the formatted string
  1. ; (if not passed, defaults to 4 spaces)
  1. ; returns a formatted string (example: 1 2 3)
  1. N DIM,I,J,RESULT,TODAY
  1. I $G(START)=""!($G(DAYS)="") Q ""
  1. I $G(SPACE)="" S SPACE=4
  1. S (RESULT,TODAY)=+$E(START,6,7)
  1. F I=1:1:SPACE S RESULT=RESULT_" "
  1. S DIM=$$DIM(START)
  1. F I=DAYS-1:-1:1 D
  1. .S TODAY=TODAY+1
  1. .I TODAY>DIM S TODAY=1
  1. .S RESULT=RESULT_$S(TODAY<10:"0"_TODAY,1:TODAY)
  1. .I I>1 D
  1. ..F J=1:1:SPACE S RESULT=RESULT_" "
  1. Q RESULT
  1. ;
  1. FMONS(START,DAYS,SPACE) ; format a sequence of months given a START date separated by SPACE...
  1. ; START = a date in FileMan internal format the month of which will be the string starting point
  1. ; DAYS = the number of days that will be displayed
  1. ; SPACE = the number of spaces between each month (defaults to 1 space)
  1. ; returns a string equal to the month or months depending upon the number of days passed
  1. ; for example: if START=3021031 (Oct 31, 2002) and DAYS=3 then two month names will be
  1. ; returned: OCT NOV
  1. N DIM,I,J,MON,MON1,NEXTMON,RESULT,TODAY,XSPACE
  1. I $G(START)=""!($G(DAYS)="") Q ""
  1. I $G(SPACE)="" S SPACE=4
  1. S (XSPACE,XSTRIP)=""
  1. F I=1:1:SPACE+1 S XSPACE=XSPACE_"*",XSTRIP=XSTRIP_" "
  1. S DIM=$$DIM(START),TODAY=+$E(START,6,7),MON1=+$E(START,4,5)
  1. S (RESULT,MON)=$$MONN(MON1)
  1. I (TODAY+DAYS)<DIM!(TODAY+DAYS=DIM) Q RESULT
  1. F I=1:1:DAYS D
  1. .S RESULT=RESULT_XSPACE
  1. .S TODAY=TODAY+1
  1. .I TODAY<DIM!(TODAY=DIM) Q
  1. .S MON1=MON1+1
  1. .I MON1>12 S MON1=1
  1. .S MON=$$MONN(MON1),RESULT=RESULT_MON
  1. .S DIM=$$DIM($E(START,1,3)_$S(MON1<10:"0"_MON1,1:MON1)),TODAY=0
  1. F I=$L(RESULT):-1 Q:$E(RESULT,I)'="*"!(I=0)
  1. S RESULT=$E(RESULT,1,I),RESULT=$TR(RESULT,XSPACE,XSTRIP)
  1. Q RESULT
  1. ;
  1. FDATES(START,DAYS,RESULTS) ;
  1. N I,X,X1,X2
  1. S RESULTS(0)=" "_$E(START,4,5)_"/"_$E(START,6,7)_" ",RESULTS(1)=START
  1. F I=1:1:DAYS-1 D
  1. .S X1=START,X2=I
  1. .D C^%DTC
  1. .S RESULTS(I+1)=X,RESULTS(0)=RESULTS(0)_" "_$E(X,4,5)_"/"_$E(X,6,7)_" "
  1. .K X,X1,X2
  1. Q
  1. ;
  1. DIM(X) ; number of days in a specified month...
  1. ; X = a date in internal FileMan format (can be partial: YYYMM)
  1. ; returns a number representing the number of days in month X
  1. I $G(X)="" Q 0
  1. N DAYS,MON,YEAR
  1. S MON=+$E(X,4,5)
  1. I MON<1 Q 0
  1. 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)
  1. ; if passed date is in Feb, check for leap year and adjust days if needed...
  1. I MON=2 D
  1. .S YEAR=+$E(X,1,3)+1700
  1. .I $$LEAP^XLFDT2(YEAR) S DAYS=29
  1. Q DAYS
  1. ;
  1. MONN(X) ; month name...
  1. ; X = month number (1-12)
  1. ; returns name of month specified in X
  1. I $G(X)="" Q ""
  1. S X=+X
  1. 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:"")
  1. ;
  1. FDATE(X) ; special format for a FileMan date/time...
  1. ; X = date and time (time is optional) in FileMan format
  1. ; returns the FileMan date/time in the format MM/DD/YY@HH:MM
  1. N DATE,FMDATE
  1. S DATE=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. S FMDATE=$$FMTE^XLFDT(X)
  1. I $P(FMDATE,"@",2)'="" S DATE=DATE_"@"_$P($P(FMDATE,"@",2),":")_":"_$P($P(FMDATE,"@",2),":",2)
  1. Q DATE
  1. ;
  1. WARDLIST(DTYPE) ; list of wards on file...
  1. ; DTYPE = 'C' for vertical (columnar) list
  1. ; 'L' for horizontal list
  1. I $G(DTYPE)="" S DTYPE="L"
  1. N ALPBWARD
  1. W !,"Wards with BCMA Backup Data on this workstation:",!
  1. S ALPBWARD=""
  1. F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
  1. .I DTYPE="L" D Q
  1. ..I $X+$L(ALPBWARD)>IOM W !
  1. ..W ALPBWARD
  1. ..I $O(^ALPB(53.7,"AW",ALPBWARD))'="" W ", "
  1. .W !?5,ALPBWARD
  1. Q
  1. ;
  1. WARDSEL(WARD,RESULTS) ; find a selected ward...
  1. ; WARD = a string representing a ward input by the user
  1. ; RESULTS = an array passed by reference in which possible matches are stored
  1. ; returns possible matches for the WARD in RESULTS
  1. N ALPBWARD,ALPBX
  1. S RESULTS(0)=0
  1. S ALPBWARD=""
  1. F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
  1. .I ALPBWARD=WARD D Q
  1. ..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
  1. .I ALPBWARD[WARD D
  1. ..S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
  1. ; if a straight lookup failed, let's try making any alphas
  1. ; entered by the user uppercase and try it once more...
  1. I RESULTS(0)=0 D
  1. .S WARD=$$UP^XLFSTR(WARD)
  1. .S ALPBWARD=""
  1. .F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
  1. ..I ALPBWARD=WARD D Q
  1. ...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
  1. ..I ALPBWARD[WARD D
  1. ...S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=ALPBWARD
  1. Q
  1. ;
  1. OTYP(CODE) ; expand order type for printing...
  1. ; CODE = a character representing an order type
  1. ; returns expanded order type from ^DD(53.79,6,0)
  1. I $G(CODE)="" Q ""
  1. Q $S(CODE="U":"UNIT DOSE",CODE="V":"IV",CODE="P":"PENDING",1:CODE)
  1. ;
  1. ORDS(IEN,DATE,RESULTS) ; retrieve orders for a given patient...
  1. ; IEN = patient's record number in file 53.7
  1. ; DATE = the date/time used to determine whether all or only current
  1. ; orders are returned:
  1. ; >passed as a date/time in FileMan internal format -- only orders
  1. ; with a stop date/time equal to or greater than DATE are returned
  1. ; >passed = "" then all orders are returned regardless of status
  1. ; returns RESULTS(order# ien) -- note: RESULTS(0)=count of active orders
  1. I +$G(IEN)=0 S RESULTS(0)=0 Q
  1. N ALPBX,ALPBY,ORDERDAT,ORDERIEN,ORDERST
  1. S (ORDERIEN,RESULTS(0))=0
  1. F S ORDERIEN=$O(^ALPB(53.7,IEN,2,ORDERIEN)) Q:'ORDERIEN D
  1. .S ORDERDAT(0)=$G(^ALPB(53.7,IEN,2,ORDERIEN,0))
  1. .S ORDERDAT(1)=$G(^ALPB(53.7,IEN,2,ORDERIEN,1))
  1. .S ORDERDAT(3)=$G(^ALPB(53.7,IEN,2,ORDERIEN,3))
  1. .S ORDERDAT(4)=$G(^ALPB(53.7,IEN,2,ORDERIEN,4))
  1. .S ORDERST=$P($P(ORDERDAT(0),"^",3),"~")
  1. .; is this order current?...
  1. .I $G(DATE)'=""&($P(ORDERDAT(1),"^",2)<$G(DATE)) K ORDERDAT Q
  1. .; if current, is it still active?...
  1. .I $G(DATE)'=""&(ORDERST'="CM")&(ORDERST'="ZS")&(ORDERST'="ZU") K ORDERDAT Q
  1. .S RESULTS(0)=RESULTS(0)+1
  1. .S RESULTS(ORDERIEN)=$P(ORDERDAT(0),"^")
  1. .S RESULTS("B",$P(ORDERDAT(0),"^"))=ORDERIEN
  1. .S RESULTS(ORDERIEN,1)=$S($P(ORDERDAT(3),"^")="V":"IV",$P(ORDERDAT(3),"^")="U":"UD",1:$P(ORDERDAT(3),"^"))
  1. .S RESULTS(ORDERIEN,2)=ORDERST
  1. .S RESULTS(ORDERIEN,3,0)=0
  1. .;S RESULTS(ORDERIEN,4)=$P($G(ORDERDAT(4)),"^",3)
  1. .S RESULTS(ORDERIEN,4)=$G(ORDERDAT(4))
  1. .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,7,0)) D
  1. ..S ALPBX=0
  1. ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,7,ALPBX)) Q:'ALPBX D
  1. ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
  1. ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,7,ALPBX,0),"^",2)
  1. ...S RESULTS(ORDERIEN,3,0)=ALPBY
  1. .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,8,0)) D
  1. ..S ALPBX=0
  1. ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,8,ALPBX)) Q:'ALPBX D
  1. ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
  1. ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,8,ALPBX,0),"^",2)_" (Additive)"
  1. ...S RESULTS(ORDERIEN,3,0)=ALPBY
  1. .I +$O(^ALPB(53.7,IEN,2,ORDERIEN,9,0)) D
  1. ..S ALPBX=0
  1. ..F S ALPBX=$O(^ALPB(53.7,IEN,2,ORDERIEN,9,ALPBX)) Q:'ALPBX D
  1. ...S ALPBY=RESULTS(ORDERIEN,3,0)+1
  1. ...S RESULTS(ORDERIEN,3,ALPBY)=$P(^ALPB(53.7,IEN,2,ORDERIEN,9,ALPBX,0),"^",2)_" (Solution)"
  1. ...S RESULTS(ORDERIEN,3,0)=ALPBY
  1. Q
  1. ;
  1. DELPT(IEN) ; delete a patient's entire record...
  1. ; IEN = patient's record number in file 53.7
  1. N DA,DIK,X,Y
  1. S DA=IEN,DIK="^ALPB(53.7,"
  1. D ^DIK
  1. ; after deleting the patient, check for any error log
  1. ; entries and delete them...
  1. D CLEAN^ALPBUTL1(IEN)
  1. Q
  1. ;
  1. DELORD(IEN,OIEN) ; delete an order from a patient's record...
  1. ; IEN = patient's record number in file 53.7
  1. ; OIEN = order number's record number
  1. N DA,DIK,X,Y
  1. S DA=OIEN,DA(1)=IEN,DIK="^ALPB(53.7,"_DA(1)_",2,"
  1. D ^DIK
  1. Q
  1. ;
  1. STATUS ; return last update date/time and count of any errors...
  1. N ALPBCNT,ALPBPARM
  1. S ALPBPARM=+$O(^ALPB(53.71,0))
  1. I ALPBPARM=0 W !,"NOTICE! There is no entry in the BCMA BACKUP PARAMETERS FILE!" Q
  1. 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")
  1. S ALPBCNT=$$ERRCT^ALPBUTL2()
  1. I ALPBCNT>0 W !,"NOTICE! ",ALPBCNT_" filing error"_$S(ALPBCNT=1:" has",1:"s have")_" been logged."
  1. Q