source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBGMG2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1PSOBGMG2 ;BHAM ISC/LC - bingo board manager (cont'd) ; 06/19/96
2 ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9
3 ;
4ASTART ;
5 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
6 .S X=DT_"."_$P($P(^PS(59.3,DGP,3),"^",3),".",2) D H^%DTC S ZTDTH=%H_","_%T D ASTART1
7 K BOT,COLM,DEV,DEV1,DEVSB,DGP,DWT,FLG,FTX,NWT,PSOUT,STOP,TASK,TCK,TOP,VOFF,VON,DIC,DIQ,DA,DR,DPTR
8 K ZH,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,ZV,%H,%T,%Y
9 Q
10ASTART1 ;start via Taskman
11 S (ASTRT,ZV,ZH,PSOUT,FLG)=0,PSOSITE=$P(^PS(59.3,DGP,3),"^",8)
12 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
13 S DIC="^%ZIS(1,",DA=DEV,DR=".01;3",DIQ="DPTR",DIQ(0)="I" D EN^DIQ1
14 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
15 S DEL2=1 D DEL
16 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
17 S COLM=$P($G(^PS(59.3,DGP,3)),"^",5),DWT=$P($G(^(3)),"^",6),NWT=$P($G(^(3)),"^",7)
18 S ADA=DGP,FTX="PRESCRIPTIONS ARE READY FOR:"
19 S ^PS(59.3,DGP,"STOP")=0,STOP=0 S TCK=$P(^PS(59.3,DGP,0),"^",2)
20 S (ZTSAVE("PSOSITE"),ZTSAVE("DEV1"),ZTSAVE("DGP"),ZTSAVE("ASTRT"),ZTSAVE("ZV"),ZTSAVE("ZH"),ZTSAVE("PSOUT"),ZTSAVE("FLG"),ZTSAVE("TOP"),ZTSAVE("BOT"),ZTSAVE("VOFF"))=""
21 S (ZTSAVE("VON"),ZTSAVE("COLM"),ZTSAVE("DWT"),ZTSAVE("NWT"),ZTSAVE("ADA"),ZTSAVE("FTX"),ZTSAVE("STOP"),ZTSAVE("TCK"))=""
22 S ZTIO=DEV1,ZTRTN=$S($G(TCK)'="T":"ANAME^PSOBGMGR",1:"TICKET^PSOBGMGR"),ZTDESC="Run Bingo Board Display"
23 D ^%ZTLOAD I $D(ZTSK) S TASK=ZTSK D
24 .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
25 .D ^DIE K DIE,DR L -^PS(59.3,DA)
26 S:$D(ZTQUEUED) ZTREQ="@"
27 Q
28ASTOP ;
29 ;stop and purge
30 S ZTSK=$P(^PS(59.3,ADA,3),"^",9) D DQ^%ZTLOAD S $P(^PS(59.3,ADA,3),"^",9)=""
31 Q
32DEL ;Del T-1's in 52.11
33 I $G(DEL2) D
34 .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
35 .K DIK,DA
36 S DIK="^PS(52.11," F DEL=0:0 S DEL=$O(^PS(52.11,DEL)) Q:'DEL D
37 .S DEL1=$P($P($G(^(DEL,0)),"^",5),".") I $G(DEL1)<DT S DA=DEL D ^DIK
38 K DIK,DEL,DEL1,DEL2
39 Q
40INIT ;init auto-start
41 S LL=0 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOSITE) Q
42 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"
43 D ^DIR G:$G(DIRUT) INIX I $G(Y)'=1 G INIJB1
44INIT1 S DIC="^PS(59.3,",DIC(0)="AEQOZ",DIC("S")="I $P($G(^(0)),U,4)'="""""
45 D ^DIC G:$D(DTOUT)!$D(DUOUT) INIX
46 G:$G(LL)=0&($G(Y)<0) INIX G:$G(LL)>0&($G(Y)<0) INIJ
47 S DA=+Y K Y,DIC
48STRTM S BSTRT=$P(^PS(59.3,DA,3),"^",3) I $G(BSTRT) D
49 .S BSTRT=$P(BSTRT,".",2),APM=$S($G(BSTRT)>1200:"PM",1:"AM")
50 .I $G(BSTRT)'<1300 S BSTRT1=+$E(BSTRT,1,2)-12_":"_$E(BSTRT,3,4)_APM
51 .I $G(BSTRT)>1200,$G(BSTRT)<1300 S BSTRT1=+$E(BSTRT,1,2)_":"_$E(BSTRT,3,4)_"PM"
52 .I $G(BSTRT)<1200 S BSTRT1=+$E(BSTRT,1,2)_":"_$E(BSTRT,3,4)_APM
53 S DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
54 S DIR("A")="Enter Start Time" S:$G(BSTRT1) DIR("B")=BSTRT1
55 S DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
56 S DIR("?")="You must enter 'PM' for time that is after 12:00 noon."
57 D ^DIR G:$D(DIRUT) INIX
58 I $P(Y,":")>12 W !?5,$C(7),"Time must be in 12 hour format",! G STRTM
59 I $L($P(Y,":"))=1 S Y="0"_Y
60 I $G(Y)["AM" S YY=$E(Y,1,5),STRTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
61 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
62 I $G(Y)'["AM"&($G(Y)'["PM") S YY=$E(Y,1,5),STRTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
63 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
64 I $G(EDT) D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") K EDT G EDTEX
65STPTM K DIR("B"),Y,YY S BSTOP=$P(^PS(59.3,DA,3),"^",4) I $G(BSTOP) D
66 .S BSTOP=$P(BSTOP,".",2),APM=$S($G(BSTOP)>1200:"PM",1:"AM")
67 .I $G(BSTOP)'<1300 S BSTOP1=+$E(BSTOP,1,2)-12_":"_$E(BSTOP,3,4)_APM
68 .I $G(BSTOP)>1200,$G(BSTOP)<1300 S BSTOP1=+$E(BSTOP,1,2)_":"_$E(BSTOP,3,4)_"PM"
69 .I $G(BSTOP)<1200 S BSTOP1=+$E(BSTOP,1,2)_":"_$E(BSTOP,3,4)_APM
70 S DIR(0)="F^1:7^K:X'?1.2N1"":""2N.A X"
71 S DIR("A")="Enter Stop Time" S:$G(BSTOP1) DIR("B")=BSTOP1
72 S DIR("?",1)="Enter time as HH:MM in 12 hour format (For example, '8:00' or '8:00AM)"
73 S DIR("?")="You must enter 'AM' for time that is before 12:00 noon."
74 D ^DIR G:$D(DIRUT) INIX
75 I $P(Y,":")>12 W !?5,$C(7),"Time must be in 12 hour format",! G STPTM
76 I $L($P(Y,":"))=1 S Y="0"_Y
77 I $G(Y)["AM" S YY=$E(Y,1,5),STPTM1=DT_"."_$P(YY,":")_$E($P(YY,":",2),1,2)
78 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
79 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
80 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
81 I $G(EDT) D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") K EDT G EDTEX
82EDTEX I $G(EDT) K BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1,Y,YY Q
83 S DIE="^PS(59.3,",DR="8///1;14////"_PSOSITE_";9////"_STRTM1_";10////"_STPTM1_""
84 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
85 D ^DIE L -^PS(59.3,DA) I $G(DIRUT)!($G(X)="") G INIX
86 W ! S LL=LL+1 K BSTRT,BSTRT1,BSTOP,BSTOP1,STRTM,STRTM1,STPTM,STPTM1 G INIT1
87INIJ 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
88INIX 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
89 Q
90INIJB1 ;
91 K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19,",X="PSO BINGO AUTOSTART" D ^DIC
92 I $O(^DIC(19.2,"B",+Y,0)) D EDIT^XUTMOPT("PSO BINGO AUTOSTART") G OUT1
93 D RESCH^XUTMOPT("PSO BINGO AUTOSTART","","","24H","L"),EDIT^XUTMOPT("PSO BINGO AUTOSTART")
94OUT1 K Y,DIC,X,PSOTM,PSOOPTN,PSOPTN,%DT,DTOUT
95 Q
Note: See TracBrowser for help on using the repository browser.