- 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 Feb 18, 2025@23:51:11 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
