PSOBGMG1 ;BHAM ISC/LC - BINGO BOARD MANAGER (CONT'D) ; 12/06/94
;;7.0;OUTPATIENT PHARMACY;**10,22,60,268**;DEC 1997;Build 9
INDX ;Re-index "ANAM" & "BA" X-REF
N DA,DIE,DR,MNY,MRX,NNM,ONM,PTR
F EN=0:0 S EN=$O(^PS(52.11,"ANAM",ADA,NAME,EN)) Q:'EN D
.I '$D(^PS(52.11,EN)) K ^PS(52.11,"ANAM",ADA,NAME,EN) Q
.S ONM=$P(^PS(52.11,EN,1),"^"),MNY=$P(^PS(52.11,EN,1),"^",3),MRX=$P(^PS(52.11,EN,1),"^",4)
.S PTR=$P(^PS(52.11,EN,0),"^"),NNM=$P(^DPT(PTR,0),"^") I NNM'=ONM D
..K ^PS(52.11,"ANAM",ADA,NAME,EN)
..S ^PS(52.11,"ANAM",ADA,MNY_MRX_" "_NNM,EN)=""
..S DA=EN,DR="8////"_NNM_"",DIE="^PS(52.11," L +^PS(52.11,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E W !!,$C(7),ONM_" is being edited!",! Q
..D ^DIE K DIE L -^PS(52.11,DA)
Q
WAIT ;compute/compare avg and normal wait times
S AWT=0
I $G(^PS(59.2,DT,1,PSOSITE,0)) D NOW^%DTC S BBH=$E($P(%,".",2),1,2),BBM=$E($P(%,".",2),3,4) D
.S:$G(BBM)>30 BBH=BBH+1 S:BBH'>9 AWT=0
.I $G(BBH)=10 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",5)+$P(^(0),"^",7)),NUM=($P(^(0),"^",4)+$P(^(0),"^",6)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=11 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",7)+$P(^(0),"^",9)),NUM=($P(^(0),"^",6)+$P(^(0),"^",8)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=12 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",9)+$P(^(0),"^",11)),NUM=($P(^(0),"^",8)+$P(^(0),"^",10)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=13 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",11)+$P(^(0),"^",13)),NUM=($P(^(0),"^",10)+$P(^(0),"^",12)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=14 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",13)+$P(^(0),"^",15)),NUM=($P(^(0),"^",12)+$P(^(0),"^",14)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=15 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",15)+$P(^(0),"^",17)),NUM=$P(^(0),"^",14)+$P(^(0),"^",16) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=16 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",17)+$P(^(0),"^",19)),NUM=($P(^(0),"^",16)+$P(^(0),"^",18)) S:$G(NUM) AWT=WTT/NUM
.I $G(BBH)=17 S WTT=($P(^PS(59.2,DT,1,PSOSITE,0),"^",19)+$P(^(0),"^",21)),NUM=($P(^(0),"^",18)+$P(^(0),"^",20)) S:$G(NUM) AWT=WTT/NUM
.S:$G(BBH)>18 AWT=0
S:AWT["." AWT2=$P(AWT,".",2),AWT=$P(AWT,".") S:$E($G(AWT2))'<5 AWT=AWT+1
S TTX=$S($G(AWT)'>$G(NWT):"NORMAL WAITING TIME IS "_NWT_" MINUTES",$G(AWT)>$G(NWT):"AVERAGE WAITING TIME IS "_AWT_" MINUTES",1:"")
Q
DEV ;select device
K NODV N DA,DR,DIC I '$D(DEV),($P($G(^PS(59.3,ADA,0)),"^",4)'="") D
.S DEV=$P($G(^PS(59.3,ADA,0)),"^",4)
.S DIC="^%ZIS(1,",DA=DEV,DR=".01;3",DIQ="DPTR",DIQ(0)="I" D EN^DIQ1
.S DEV=$G(DPTR(3.5,DA,.01,DIQ(0))),DEVSB=$G(DPTR(3.5,DA,3,DIQ(0)))
.S DIC="^%ZIS(2,",DA=DEVSB,DR=".01",DIQ="DEVSB1",DIQ(0)="I" D EN^DIQ1
I $D(DEV) S %ZIS("B")=DEV,%ZIS("S")="I $E($G(DEVSB1(3.2,DA,.01,DIQ(0))),1,4)=""C-VT""",%ZIS="Q" D ^%ZIS S DV=ION I POP S NODV=1 Q
I '$D(DEV) S %ZIS="LQ",%ZIS("S")="I $E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1,4)=""C-VT""" D ^%ZIS S DV=ION I POP S NODV=1 Q
I $G(IOST)'["C-VT" W !,$C(7),"Improper device selected. Try again!",! G DEV
K DPTR,DEVSB,DEVSB1,DIQ
I $D(IO("Q")) D QUE,^%ZISC Q
U IO D:$G(TCK)'="T" ANAME^PSOBGMGR D:$G(TCK)="T" TICKET^PSOBGMGR D ^%ZISC
Q
QUE ;que job
S (ZTSAVE("PSOSITE"),ZTSAVE("DEV"),ZTSAVE("ZV"),ZTSAVE("ZH"),ZTSAVE("PSOUT"),ZTSAVE("FLG"),ZTSAVE("TOP"),ZTSAVE("BOT"),ZTSAVE("VOFF"))=""
S (ZTSAVE("VON"),ZTSAVE("COLM"),ZTSAVE("DWT"),ZTSAVE("NWT"),ZTSAVE("ADA"),ZTSAVE("FTX"),ZTSAVE("STOP"),ZTSAVE("TCK"))=""
S ZTIO=DV,ZTRTN=$S($G(TCK)'="T":"ANAME^PSOBGMGR",1:"TICKET^PSOBGMGR"),ZTDESC="Run Bingo Board Display"
D ^%ZTLOAD
I $D(ZTSK) S TASK=ZTSK D
.S DA=ADA,DR="15////"_TASK_"",DIE="^PS(59.3," L +^PS(59.3,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E W !!,$C(7),"File is being edited!",! Q
.D ^DIE K DIE,DR L -^PS(59.3,DA)
I $D(ZTSK)[0 W !!?5,"Auto-start aborted!"
E W !!?5,"Bingo Board has been queued!"
S:$D(ZTQUEUED) ZTREQ="@"
D HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBGMG1 3817 printed Dec 13, 2024@02:24:44 Page 2
PSOBGMG1 ;BHAM ISC/LC - BINGO BOARD MANAGER (CONT'D) ; 12/06/94
+1 ;;7.0;OUTPATIENT PHARMACY;**10,22,60,268**;DEC 1997;Build 9
INDX ;Re-index "ANAM" & "BA" X-REF
+1 NEW DA,DIE,DR,MNY,MRX,NNM,ONM,PTR
+2 FOR EN=0:0
SET EN=$ORDER(^PS(52.11,"ANAM",ADA,NAME,EN))
if 'EN
QUIT
Begin DoDot:1
+3 IF '$DATA(^PS(52.11,EN))
KILL ^PS(52.11,"ANAM",ADA,NAME,EN)
QUIT
+4 SET ONM=$PIECE(^PS(52.11,EN,1),"^")
SET MNY=$PIECE(^PS(52.11,EN,1),"^",3)
SET MRX=$PIECE(^PS(52.11,EN,1),"^",4)
+5 SET PTR=$PIECE(^PS(52.11,EN,0),"^")
SET NNM=$PIECE(^DPT(PTR,0),"^")
IF NNM'=ONM
Begin DoDot:2
+6 KILL ^PS(52.11,"ANAM",ADA,NAME,EN)
+7 SET ^PS(52.11,"ANAM",ADA,MNY_MRX_" "_NNM,EN)=""
+8 SET DA=EN
SET DR="8////"_NNM_""
SET DIE="^PS(52.11,"
LOCK +^PS(52.11,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
WRITE !!,$CHAR(7),ONM_" is being edited!",!
QUIT
+9 DO ^DIE
KILL DIE
LOCK -^PS(52.11,DA)
End DoDot:2
End DoDot:1
+10 QUIT
WAIT ;compute/compare avg and normal wait times
+1 SET AWT=0
+2 IF $GET(^PS(59.2,DT,1,PSOSITE,0))
DO NOW^%DTC
SET BBH=$EXTRACT($PIECE(%,".",2),1,2)
SET BBM=$EXTRACT($PIECE(%,".",2),3,4)
Begin DoDot:1
+3 if $GET(BBM)>30
SET BBH=BBH+1
if BBH'>9
SET AWT=0
+4 IF $GET(BBH)=10
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",5)+$PIECE(^(0),"^",7))
SET NUM=($PIECE(^(0),"^",4)+$PIECE(^(0),"^",6))
if $GET(NUM)
SET AWT=WTT/NUM
+5 IF $GET(BBH)=11
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",7)+$PIECE(^(0),"^",9))
SET NUM=($PIECE(^(0),"^",6)+$PIECE(^(0),"^",8))
if $GET(NUM)
SET AWT=WTT/NUM
+6 IF $GET(BBH)=12
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",9)+$PIECE(^(0),"^",11))
SET NUM=($PIECE(^(0),"^",8)+$PIECE(^(0),"^",10))
if $GET(NUM)
SET AWT=WTT/NUM
+7 IF $GET(BBH)=13
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",11)+$PIECE(^(0),"^",13))
SET NUM=($PIECE(^(0),"^",10)+$PIECE(^(0),"^",12))
if $GET(NUM)
SET AWT=WTT/NUM
+8 IF $GET(BBH)=14
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",13)+$PIECE(^(0),"^",15))
SET NUM=($PIECE(^(0),"^",12)+$PIECE(^(0),"^",14))
if $GET(NUM)
SET AWT=WTT/NUM
+9 IF $GET(BBH)=15
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",15)+$PIECE(^(0),"^",17))
SET NUM=$PIECE(^(0),"^",14)+$PIECE(^(0),"^",16)
if $GET(NUM)
SET AWT=WTT/NUM
+10 IF $GET(BBH)=16
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",17)+$PIECE(^(0),"^",19))
SET NUM=($PIECE(^(0),"^",16)+$PIECE(^(0),"^",18))
if $GET(NUM)
SET AWT=WTT/NUM
+11 IF $GET(BBH)=17
SET WTT=($PIECE(^PS(59.2,DT,1,PSOSITE,0),"^",19)+$PIECE(^(0),"^",21))
SET NUM=($PIECE(^(0),"^",18)+$PIECE(^(0),"^",20))
if $GET(NUM)
SET AWT=WTT/NUM
+12 if $GET(BBH)>18
SET AWT=0
End DoDot:1
+13 if AWT["."
SET AWT2=$PIECE(AWT,".",2)
SET AWT=$PIECE(AWT,".")
if $EXTRACT($GET(AWT2))'<5
SET AWT=AWT+1
+14 SET TTX=$SELECT($GET(AWT)'>$GET(NWT):"NORMAL WAITING TIME IS "_NWT_" MINUTES",$GET(AWT)>$GET(NWT):"AVERAGE WAITING TIME IS "_AWT_" MINUTES",1:"")
+15 QUIT
DEV ;select device
+1 KILL NODV
NEW DA,DR,DIC
IF '$DATA(DEV)
IF ($PIECE($GET(^PS(59.3,ADA,0)),"^",4)'="")
Begin DoDot:1
+2 SET DEV=$PIECE($GET(^PS(59.3,ADA,0)),"^",4)
+3 SET DIC="^%ZIS(1,"
SET DA=DEV
SET DR=".01;3"
SET DIQ="DPTR"
SET DIQ(0)="I"
DO EN^DIQ1
+4 SET DEV=$GET(DPTR(3.5,DA,.01,DIQ(0)))
SET DEVSB=$GET(DPTR(3.5,DA,3,DIQ(0)))
+5 SET DIC="^%ZIS(2,"
SET DA=DEVSB
SET DR=".01"
SET DIQ="DEVSB1"
SET DIQ(0)="I"
DO EN^DIQ1
End DoDot:1
+6 IF $DATA(DEV)
SET %ZIS("B")=DEV
SET %ZIS("S")="I $E($G(DEVSB1(3.2,DA,.01,DIQ(0))),1,4)=""C-VT"""
SET %ZIS="Q"
DO ^%ZIS
SET DV=ION
IF POP
SET NODV=1
QUIT
+7 IF '$DATA(DEV)
SET %ZIS="LQ"
SET %ZIS("S")="I $E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1,4)=""C-VT"""
DO ^%ZIS
SET DV=ION
IF POP
SET NODV=1
QUIT
+8 IF $GET(IOST)'["C-VT"
WRITE !,$CHAR(7),"Improper device selected. Try again!",!
GOTO DEV
+9 KILL DPTR,DEVSB,DEVSB1,DIQ
+10 IF $DATA(IO("Q"))
DO QUE
DO ^%ZISC
QUIT
+11 USE IO
if $GET(TCK)'="T"
DO ANAME^PSOBGMGR
if $GET(TCK)="T"
DO TICKET^PSOBGMGR
DO ^%ZISC
+12 QUIT
QUE ;que job
+1 SET (ZTSAVE("PSOSITE"),ZTSAVE("DEV"),ZTSAVE("ZV"),ZTSAVE("ZH"),ZTSAVE("PSOUT"),ZTSAVE("FLG"),ZTSAVE("TOP"),ZTSAVE("BOT"),ZTSAVE("VOFF"))=""
+2 SET (ZTSAVE("VON"),ZTSAVE("COLM"),ZTSAVE("DWT"),ZTSAVE("NWT"),ZTSAVE("ADA"),ZTSAVE("FTX"),ZTSAVE("STOP"),ZTSAVE("TCK"))=""
+3 SET ZTIO=DV
SET ZTRTN=$SELECT($GET(TCK)'="T":"ANAME^PSOBGMGR",1:"TICKET^PSOBGMGR")
SET ZTDESC="Run Bingo Board Display"
+4 DO ^%ZTLOAD
+5 IF $DATA(ZTSK)
SET TASK=ZTSK
Begin DoDot:1
+6 SET DA=ADA
SET DR="15////"_TASK_""
SET DIE="^PS(59.3,"
LOCK +^PS(59.3,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
WRITE !!,$CHAR(7),"File is being edited!",!
QUIT
+7 DO ^DIE
KILL DIE,DR
LOCK -^PS(59.3,DA)
End DoDot:1
+8 IF $DATA(ZTSK)[0
WRITE !!?5,"Auto-start aborted!"
+9 IF '$TEST
WRITE !!?5,"Bingo Board has been queued!"
+10 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+11 DO HOME^%ZIS
+12 QUIT
