- PSOBGMG2 ;BHAM ISC/LC - bingo board manager (cont'd) ; 06/19/96
- ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9
- ;
- ASTART ;
- S DGP=0 F S DGP=$O(^PS(59.3,DGP)) Q:'DGP I $P($G(^PS(59.3,DGP,3)),"^")=1,$P($G(^(3)),"^",3)'="" D
- .S X=DT_"."_$P($P(^PS(59.3,DGP,3),"^",3),".",2) D H^%DTC S ZTDTH=%H_","_%T D ASTART1
- K BOT,COLM,DEV,DEV1,DEVSB,DGP,DWT,FLG,FTX,NWT,PSOUT,STOP,TASK,TCK,TOP,VOFF,VON,DIC,DIQ,DA,DR,DPTR
- K ZH,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,ZV,%H,%T,%Y
- Q
- ASTART1 ;start via Taskman
- S (ASTRT,ZV,ZH,PSOUT,FLG)=0,PSOSITE=$P(^PS(59.3,DGP,3),"^",8)
- S:$P($G(^PS(59.3,DGP,0)),"^",4)'="" DEV=$P($G(^PS(59.3,DGP,0)),"^",4) I '$D(DEV) S ASTRT=3 Q
- S DIC="^%ZIS(1,",DA=DEV,DR=".01;3",DIQ="DPTR",DIQ(0)="I" D EN^DIQ1
- S DEV1=$G(DPTR(3.5,DA,.01,DIQ(0))),DEVSB=$G(DPTR(3.5,DA,3,DIQ(0))) I '$D(DEV1) S ASTRT=3 Q
- S DEL2=1 D DEL
- S IOST(0)=$G(DEVSB) S X="IODHLT;IODHLB;IORVOFF;IORVON" D ENDR^%ZISS S TOP=IODHLT,BOT=IODHLB,VOFF=IORVOFF,VON=IORVON K IODHLT,IODHLB,IORVOFF,IORVON,DIC
- S COLM=$P($G(^PS(59.3,DGP,3)),"^",5),DWT=$P($G(^(3)),"^",6),NWT=$P($G(^(3)),"^",7)
- S ADA=DGP,FTX="PRESCRIPTIONS ARE READY FOR:"
- S ^PS(59.3,DGP,"STOP")=0,STOP=0 S TCK=$P(^PS(59.3,DGP,0),"^",2)
- S (ZTSAVE("PSOSITE"),ZTSAVE("DEV1"),ZTSAVE("DGP"),ZTSAVE("ASTRT"),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=DEV1,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)
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ASTOP ;
- ;stop and purge
- S ZTSK=$P(^PS(59.3,ADA,3),"^",9) D DQ^%ZTLOAD S $P(^PS(59.3,ADA,3),"^",9)=""
- Q
- DEL ;Del T-1's in 52.11
- I $G(DEL2) D
- .S DIK="^PS(52.11,",DA=0 F S DA=$O(^PS(52.11,DA)) Q:'DA D:$P($G(^PS(52.11,DA,0)),"^",3)=DGP ^DIK
- .K DIK,DA
- S DIK="^PS(52.11," F DEL=0:0 S DEL=$O(^PS(52.11,DEL)) Q:'DEL D
- .S DEL1=$P($P($G(^(DEL,0)),"^",5),".") I $G(DEL1)<DT S DA=DEL D ^DIK
- K DIK,DEL,DEL1,DEL2
- Q
- INIT ;init auto-start
- S LL=0 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOSITE) Q
- W ! S DIR(0)="Y",DIR("A")="You want to edit Display Group(s) Start/Stop times",DIR("?")="Enter 'Y' for Yes or 'N' for No.",DIR("B")="NO"
- D ^DIR G:$G(DIRUT) INIX I $G(Y)'=1 G INIJB1
- INIT1 S DIC="^PS(59.3,",DIC(0)="AEQOZ",DIC("S")="I $P($G(^(0)),U,4)'="""""
- D ^DIC G:$D(DTOUT)!$D(DUOUT) INIX
- G:$G(LL)=0&($G(Y)<0) INIX G:$G(LL)>0&($G(Y)<0) INIJ
- S DA=+Y K Y,DIC
- STRTM S BSTRT=$P(^PS(59.3,DA,3),"^",3) I $G(BSTRT) D
- .S BSTRT=$P(BSTRT,".",2),APM=$S($G(BSTRT)>1200:"PM",1:"AM")
- .I $G(BSTRT)'<1300 S BSTRT1=+$E(BSTRT,1,2)-12_":"_$E(BSTRT,3,4)_APM
- .I $G(BSTRT)>1200,$G(BSTRT)<1300 S BSTRT1=+$E(BSTRT,1,2)_":"_$E(BSTRT,3,4)_"PM"
- .I $G(BSTRT)<1200 S BSTRT1=+$E(BSTRT,1,2)_":"_$E(BSTRT,3,4)_APM
- S DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
- S DIR("A")="Enter Start Time" S:$G(BSTRT1) DIR("B")=BSTRT1
- S DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
- S DIR("?")="You must enter 'PM' for time that is after 12:00 noon."
- D ^DIR G:$D(DIRUT) INIX
- I $P(Y,":")>12 W !?5,$C(7),"Time must be in 12 hour format",! G STRTM
- I $L($P(Y,":"))=1 S Y="0"_Y
- I $G(Y)["AM" S YY=$E(Y,1,5),STRTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
- I $G(Y)["PM" S YY=$E(Y,1,5),STRTM=$P(YY,":")_$E($P(YY,":",2),1,2) S:STRTM'<1200 STRTM1=DT_"."_STRTM S:STRTM<1200 STRTM=STRTM+1200,STRTM1=DT_"."_STRTM
- I $G(Y)'["AM"&($G(Y)'["PM") S YY=$E(Y,1,5),STRTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
- I $G(EDT) S DIE="^PS(59.3,",DR="9////"_STRTM1_"" L +^PS(59.3,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E W !!,$C(7),Y(0,0)," is being edited!",! K EDT Q
- I $G(EDT) D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") K EDT G EDTEX
- STPTM K DIR("B"),Y,YY S BSTOP=$P(^PS(59.3,DA,3),"^",4) I $G(BSTOP) D
- .S BSTOP=$P(BSTOP,".",2),APM=$S($G(BSTOP)>1200:"PM",1:"AM")
- .I $G(BSTOP)'<1300 S BSTOP1=+$E(BSTOP,1,2)-12_":"_$E(BSTOP,3,4)_APM
- .I $G(BSTOP)>1200,$G(BSTOP)<1300 S BSTOP1=+$E(BSTOP,1,2)_":"_$E(BSTOP,3,4)_"PM"
- .I $G(BSTOP)<1200 S BSTOP1=+$E(BSTOP,1,2)_":"_$E(BSTOP,3,4)_APM
- S DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
- S DIR("A")="Enter Stop Time" S:$G(BSTOP1) DIR("B")=BSTOP1
- S DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
- S DIR("?")="You must enter 'AM' for time that is before 12:00 noon."
- D ^DIR G:$D(DIRUT) INIX
- I $P(Y,":")>12 W !?5,$C(7),"Time must be in 12 hour format",! G STPTM
- I $L($P(Y,":"))=1 S Y="0"_Y
- I $G(Y)["AM" S YY=$E(Y,1,5),STPTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
- I $G(Y)["PM" S YY=$E(Y,1,5),STPTM=$P(YY,":")_$E($P(YY,":",2),1,2) S:STPTM'<1200 STPTM1=DT_"."_STPTM S:STPTM<1200 STPTM=STPTM+1200,STPTM1=DT_"."_STPTM
- I $G(Y)'["AM"&($G(Y)'["PM") S YY=$E(Y,1,5),STPTM=$P(YY,":")_$E($P(YY,":",2),1,2) S:STPTM'<1200 STPTM1=DT_"."_STPTM S:STPTM<1200 STPTM=STPTM+1200,STPTM1=DT_"."_STPTM
- I $G(EDT) S DIE="^PS(59.3,",DR="10////"_STPTM1_"" L +^PS(59.3,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E W !!,$C(7),Y(0,0)," is being edited!",! K EDT Q
- I $G(EDT) D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") K EDT G EDTEX
- EDTEX I $G(EDT) K BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1,Y,YY Q
- S DIE="^PS(59.3,",DR="8///1;14////"_PSOSITE_";9////"_STRTM1_";10////"_STPTM1_""
- L +^PS(59.3,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E W !!,$C(7),Y(0,0)," is being edited!",! Q
- D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") G INIX
- W ! S LL=LL+1 K BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1 G INIT1
- INIJ S BTDV=$P(^PS(59.3,DA,0),"^",4),BTST=$P(^PS(59.3,DA,3),"^",3),BTSP=$P(^(3),"^",4) I $G(BTDV)&$G(BTST) D INIJB1
- INIX K APM,BTDV,BTDV1,BTSP,BTSP1,BTST,BTST1,DA,DIC,DIE,DIR,DUOUT,DTOUT,LL,STRTM,STRTM,STPTM,STPTM1,BSTRT,BSTRT1,BSTOP,BSTOP1,X,Y,YY,EDT
- Q
- INIJB1 ;
- K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19,",X="PSO BINGO AUTOSTART" D ^DIC
- I $O(^DIC(19.2,"B",+Y,0)) D EDIT^XUTMOPT("PSO BINGO AUTOSTART") G OUT1
- D RESCH^XUTMOPT("PSO BINGO AUTOSTART","","","24H","L"),EDIT^XUTMOPT("PSO BINGO AUTOSTART")
- OUT1 K Y,DIC,X,PSOTM,PSOOPTN,PSOPTN,%DT,DTOUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBGMG2 6354 printed Feb 18, 2025@23:51:12 Page 2
- PSOBGMG2 ;BHAM ISC/LC - bingo board manager (cont'd) ; 06/19/96
- +1 ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9
- +2 ;
- ASTART ;
- +1 SET DGP=0
- FOR
- SET DGP=$ORDER(^PS(59.3,DGP))
- if 'DGP
- QUIT
- IF $PIECE($GET(^PS(59.3,DGP,3)),"^")=1
- IF $PIECE($GET(^(3)),"^",3)'=""
- Begin DoDot:1
- +2 SET X=DT_"."_$PIECE($PIECE(^PS(59.3,DGP,3),"^",3),".",2)
- DO H^%DTC
- SET ZTDTH=%H_","_%T
- DO ASTART1
- End DoDot:1
- +3 KILL BOT,COLM,DEV,DEV1,DEVSB,DGP,DWT,FLG,FTX,NWT,PSOUT,STOP,TASK,TCK,TOP,VOFF,VON,DIC,DIQ,DA,DR,DPTR
- +4 KILL ZH,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,ZV,%H,%T,%Y
- +5 QUIT
- ASTART1 ;start via Taskman
- +1 SET (ASTRT,ZV,ZH,PSOUT,FLG)=0
- SET PSOSITE=$PIECE(^PS(59.3,DGP,3),"^",8)
- +2 if $PIECE($GET(^PS(59.3,DGP,0)),"^",4)'=""
- SET DEV=$PIECE($GET(^PS(59.3,DGP,0)),"^",4)
- IF '$DATA(DEV)
- SET ASTRT=3
- QUIT
- +3 SET DIC="^%ZIS(1,"
- SET DA=DEV
- SET DR=".01;3"
- SET DIQ="DPTR"
- SET DIQ(0)="I"
- DO EN^DIQ1
- +4 SET DEV1=$GET(DPTR(3.5,DA,.01,DIQ(0)))
- SET DEVSB=$GET(DPTR(3.5,DA,3,DIQ(0)))
- IF '$DATA(DEV1)
- SET ASTRT=3
- QUIT
- +5 SET DEL2=1
- DO DEL
- +6 SET IOST(0)=$GET(DEVSB)
- SET X="IODHLT;IODHLB;IORVOFF;IORVON"
- DO ENDR^%ZISS
- SET TOP=IODHLT
- SET BOT=IODHLB
- SET VOFF=IORVOFF
- SET VON=IORVON
- KILL IODHLT,IODHLB,IORVOFF,IORVON,DIC
- +7 SET COLM=$PIECE($GET(^PS(59.3,DGP,3)),"^",5)
- SET DWT=$PIECE($GET(^(3)),"^",6)
- SET NWT=$PIECE($GET(^(3)),"^",7)
- +8 SET ADA=DGP
- SET FTX="PRESCRIPTIONS ARE READY FOR:"
- +9 SET ^PS(59.3,DGP,"STOP")=0
- SET STOP=0
- SET TCK=$PIECE(^PS(59.3,DGP,0),"^",2)
- +10 SET (ZTSAVE("PSOSITE"),ZTSAVE("DEV1"),ZTSAVE("DGP"),ZTSAVE("ASTRT"),ZTSAVE("ZV"),ZTSAVE("ZH"),ZTSAVE("PSOUT"),ZTSAVE("FLG"),ZTSAVE("TOP"),ZTSAVE("BOT"),ZTSAVE("VOFF"))=""
- +11 SET (ZTSAVE("VON"),ZTSAVE("COLM"),ZTSAVE("DWT"),ZTSAVE("NWT"),ZTSAVE("ADA"),ZTSAVE("FTX"),ZTSAVE("STOP"),ZTSAVE("TCK"))=""
- +12 SET ZTIO=DEV1
- SET ZTRTN=$SELECT($GET(TCK)'="T":"ANAME^PSOBGMGR",1:"TICKET^PSOBGMGR")
- SET ZTDESC="Run Bingo Board Display"
- +13 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- SET TASK=ZTSK
- Begin DoDot:1
- +14 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
- +15 DO ^DIE
- KILL DIE,DR
- LOCK -^PS(59.3,DA)
- End DoDot:1
- +16 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +17 QUIT
- ASTOP ;
- +1 ;stop and purge
- +2 SET ZTSK=$PIECE(^PS(59.3,ADA,3),"^",9)
- DO DQ^%ZTLOAD
- SET $PIECE(^PS(59.3,ADA,3),"^",9)=""
- +3 QUIT
- DEL ;Del T-1's in 52.11
- +1 IF $GET(DEL2)
- Begin DoDot:1
- +2 SET DIK="^PS(52.11,"
- SET DA=0
- FOR
- SET DA=$ORDER(^PS(52.11,DA))
- if 'DA
- QUIT
- if $PIECE($GET(^PS(52.11,DA,0)),"^",3)=DGP
- DO ^DIK
- +3 KILL DIK,DA
- End DoDot:1
- +4 SET DIK="^PS(52.11,"
- FOR DEL=0:0
- SET DEL=$ORDER(^PS(52.11,DEL))
- if 'DEL
- QUIT
- Begin DoDot:1
- +5 SET DEL1=$PIECE($PIECE($GET(^(DEL,0)),"^",5),".")
- IF $GET(DEL1)<DT
- SET DA=DEL
- DO ^DIK
- End DoDot:1
- +6 KILL DIK,DEL,DEL1,DEL2
- +7 QUIT
- INIT ;init auto-start
- +1 SET LL=0
- if '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOSITE)
- QUIT
- +2 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="You want to edit Display Group(s) Start/Stop times"
- SET DIR("?")="Enter 'Y' for Yes or 'N' for No."
- SET DIR("B")="NO"
- +3 DO ^DIR
- if $GET(DIRUT)
- GOTO INIX
- IF $GET(Y)'=1
- GOTO INIJB1
- INIT1 SET DIC="^PS(59.3,"
- SET DIC(0)="AEQOZ"
- SET DIC("S")="I $P($G(^(0)),U,4)'="""""
- +1 DO ^DIC
- if $DATA(DTOUT)!$DATA(DUOUT)
- GOTO INIX
- +2 if $GET(LL)=0&($GET(Y)<0)
- GOTO INIX
- if $GET(LL)>0&($GET(Y)<0)
- GOTO INIJ
- +3 SET DA=+Y
- KILL Y,DIC
- STRTM SET BSTRT=$PIECE(^PS(59.3,DA,3),"^",3)
- IF $GET(BSTRT)
- Begin DoDot:1
- +1 SET BSTRT=$PIECE(BSTRT,".",2)
- SET APM=$SELECT($GET(BSTRT)>1200:"PM",1:"AM")
- +2 IF $GET(BSTRT)'<1300
- SET BSTRT1=+$EXTRACT(BSTRT,1,2)-12_":"_$EXTRACT(BSTRT,3,4)_APM
- +3 IF $GET(BSTRT)>1200
- IF $GET(BSTRT)<1300
- SET BSTRT1=+$EXTRACT(BSTRT,1,2)_":"_$EXTRACT(BSTRT,3,4)_"PM"
- +4 IF $GET(BSTRT)<1200
- SET BSTRT1=+$EXTRACT(BSTRT,1,2)_":"_$EXTRACT(BSTRT,3,4)_APM
- End DoDot:1
- +5 SET DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
- +6 SET DIR("A")="Enter Start Time"
- if $GET(BSTRT1)
- SET DIR("B")=BSTRT1
- +7 SET DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
- +8 SET DIR("?")="You must enter 'PM' for time that is after 12:00 noon."
- +9 DO ^DIR
- if $DATA(DIRUT)
- GOTO INIX
- +10 IF $PIECE(Y,":")>12
- WRITE !?5,$CHAR(7),"Time must be in 12 hour format",!
- GOTO STRTM
- +11 IF $LENGTH($PIECE(Y,":"))=1
- SET Y="0"_Y
- +12 IF $GET(Y)["AM"
- SET YY=$EXTRACT(Y,1,5)
- SET STRTM1=DT_"."_$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- +13 IF $GET(Y)["PM"
- SET YY=$EXTRACT(Y,1,5)
- SET STRTM=$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- if STRTM'<1200
- SET STRTM1=DT_"."_STRTM
- if STRTM<1200
- SET STRTM=STRTM+1200
- SET STRTM1=DT_"."_STRTM
- +14 IF $GET(Y)'["AM"&($GET(Y)'["PM")
- SET YY=$EXTRACT(Y,1,5)
- SET STRTM1=DT_"."_$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- +15 IF $GET(EDT)
- SET DIE="^PS(59.3,"
- SET DR="9////"_STRTM1_""
- LOCK +^PS(59.3,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- WRITE !!,$CHAR(7),Y(0,0)," is being edited!",!
- KILL EDT
- QUIT
- +16 IF $GET(EDT)
- DO ^DIE
- LOCK -^PS(59.3,DA)
- IF $GET(DIRUT)!($GET(X)="")
- KILL EDT
- GOTO EDTEX
- STPTM KILL DIR("B"),Y,YY
- SET BSTOP=$PIECE(^PS(59.3,DA,3),"^",4)
- IF $GET(BSTOP)
- Begin DoDot:1
- +1 SET BSTOP=$PIECE(BSTOP,".",2)
- SET APM=$SELECT($GET(BSTOP)>1200:"PM",1:"AM")
- +2 IF $GET(BSTOP)'<1300
- SET BSTOP1=+$EXTRACT(BSTOP,1,2)-12_":"_$EXTRACT(BSTOP,3,4)_APM
- +3 IF $GET(BSTOP)>1200
- IF $GET(BSTOP)<1300
- SET BSTOP1=+$EXTRACT(BSTOP,1,2)_":"_$EXTRACT(BSTOP,3,4)_"PM"
- +4 IF $GET(BSTOP)<1200
- SET BSTOP1=+$EXTRACT(BSTOP,1,2)_":"_$EXTRACT(BSTOP,3,4)_APM
- End DoDot:1
- +5 SET DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
- +6 SET DIR("A")="Enter Stop Time"
- if $GET(BSTOP1)
- SET DIR("B")=BSTOP1
- +7 SET DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
- +8 SET DIR("?")="You must enter 'AM' for time that is before 12:00 noon."
- +9 DO ^DIR
- if $DATA(DIRUT)
- GOTO INIX
- +10 IF $PIECE(Y,":")>12
- WRITE !?5,$CHAR(7),"Time must be in 12 hour format",!
- GOTO STPTM
- +11 IF $LENGTH($PIECE(Y,":"))=1
- SET Y="0"_Y
- +12 IF $GET(Y)["AM"
- SET YY=$EXTRACT(Y,1,5)
- SET STPTM1=DT_"."_$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- +13 IF $GET(Y)["PM"
- SET YY=$EXTRACT(Y,1,5)
- SET STPTM=$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- if STPTM'<1200
- SET STPTM1=DT_"."_STPTM
- if STPTM<1200
- SET STPTM=STPTM+1200
- SET STPTM1=DT_"."_STPTM
- +14 IF $GET(Y)'["AM"&($GET(Y)'["PM")
- SET YY=$EXTRACT(Y,1,5)
- SET STPTM=$PIECE(YY,":")_$EXTRACT($PIECE(YY,":",2),1,2)
- if STPTM'<1200
- SET STPTM1=DT_"."_STPTM
- if STPTM<1200
- SET STPTM=STPTM+1200
- SET STPTM1=DT_"."_STPTM
- +15 IF $GET(EDT)
- SET DIE="^PS(59.3,"
- SET DR="10////"_STPTM1_""
- LOCK +^PS(59.3,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- WRITE !!,$CHAR(7),Y(0,0)," is being edited!",!
- KILL EDT
- QUIT
- +16 IF $GET(EDT)
- DO ^DIE
- LOCK -^PS(59.3,DA)
- IF $GET(DIRUT)!($GET(X)="")
- KILL EDT
- GOTO EDTEX
- EDTEX IF $GET(EDT)
- KILL BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1,Y,YY
- QUIT
- +1 SET DIE="^PS(59.3,"
- SET DR="8///1;14////"_PSOSITE_";9////"_STRTM1_";10////"_STPTM1_""
- +2 LOCK +^PS(59.3,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- WRITE !!,$CHAR(7),Y(0,0)," is being edited!",!
- QUIT
- +3 DO ^DIE
- LOCK -^PS(59.3,DA)
- IF $GET(DIRUT)!($GET(X)="")
- GOTO INIX
- +4 WRITE !
- SET LL=LL+1
- KILL BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1
- GOTO INIT1
- INIJ SET BTDV=$PIECE(^PS(59.3,DA,0),"^",4)
- SET BTST=$PIECE(^PS(59.3,DA,3),"^",3)
- SET BTSP=$PIECE(^(3),"^",4)
- IF $GET(BTDV)&$GET(BTST)
- DO INIJB1
- INIX KILL APM,BTDV,BTDV1,BTSP,BTSP1,BTST,BTST1,DA,DIC,DIE,DIR,DUOUT,DTOUT,LL,STRTM,STRTM,STPTM,STPTM1,BSTRT,BSTRT1,BSTOP,BSTOP1,X,Y,YY,EDT
- +1 QUIT
- INIJB1 ;
- +1 KILL %DT,DIC,DTOUT
- SET DIC(0)="XZM"
- SET DIC="^DIC(19,"
- SET X="PSO BINGO AUTOSTART"
- DO ^DIC
- +2 IF $ORDER(^DIC(19.2,"B",+Y,0))
- DO EDIT^XUTMOPT("PSO BINGO AUTOSTART")
- GOTO OUT1
- +3 DO RESCH^XUTMOPT("PSO BINGO AUTOSTART","","","24H","L")
- DO EDIT^XUTMOPT("PSO BINGO AUTOSTART")
- OUT1 KILL Y,DIC,X,PSOTM,PSOOPTN,PSOPTN,%DT,DTOUT
- +1 QUIT
