source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGL0.m@ 701

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSGL0 ;BIR/CML3-ACTUAL LABEL PRINT ; 26 Jun 98 / 8:30 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**7**;16 DEC 97
3ENACL ;
4 W !!,"There are unprinted new labels from AUTO ",$S(PSGTOL=3:"REINSTATED",1:"DISCONTINUED")," orders." F W !,"Do you want any of them now" S %=1 D YN^DICN Q:% D CHKM^PSGLH
5 Q:%<0 I %=1 D ENAC S %=1 Q
6 F W !!,"Will you want these labels at a later date" S %=1 D YN^DICN Q:% D LM^PSGLH
7 Q:%'=2 S DIK="^PS(53.41,",DA=PSGTOL D ^DIK S %=2 Q
8 ;
9ENAC ; select ward
10 W !!,"Wards: " S NP="",QQ=0 F W=1:1 S QQ=$O(^PS(53.41,PSGTOL,1,QQ)) Q:'QQ D NP:'(W#20) Q:NP["^" W !,$J(W,3),". ",$S($D(^DIC(42,QQ,0)):$P(^(0),"^"),1:QQ) S W(W)=QQ
11 S W=W-1 I 'W K ^PS(53.41,PSGTOL) W !!?3,"Sorry, no labels were found after all. (The problem has been corrected.)",! Q
12 F W !!,"Select 1 - ",W,": " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D SC Q:$D(X)
13 G:"^"[X DONE S PSGLWARD=PSGODDD F Q=1:1:PSGODDD F Q1=1:1 S Q2=$P(PSGODDD(Q),",",Q1) Q:'Q2 S PSGLWARD(Q)=$S($D(PSGLWARD(Q)):PSGLWARD(Q)_",",1:"")_W(Q2)
14 K ZTSAVE S PSGLRTN="ENACP^PSGL0",PSGLDESC="MAR AUTO LABELS",(ZTSAVE("PSGLWARD"),ZTSAVE("PSGLWARD("),ZTSAVE("PSGTOL"))="" D DEV1 I 'POP,'$D(IO("Q")) D ENACP
15 G DONE
16 ;
17ENNL ; new labels, other than auto discontinue
18 K ZTSAVE S PSGLRTN="ENNLP^PSGL0",PSGLDESC="UD NEW LABEL REPRINT" D DEV1 G:POP!$D(IO("Q")) DONE D ENNLP
19 ;
20SC ; selection validation
21 I X?1."?" W !!," Select (1-",W,") the ward(s) you wish to print labels for. Enter an '^',",!,"or press the RETURN key, to quit now." K X Q
22 Q:'$D(W)
23 S PSGLMT=W D ^PSGON W:'$D(X) $C(7)," ??" Q
24 ;
25DEV1 ; device ask for auto discontinue or new labels
26 K IO("Q"),%ZIS,IOP S PSGION=ION,%ZIS="Q",%ZIS("A")="Label Printing Device: ",%ZIS("B")=$P(PSJSYSL,"^",2) W ! D ^%ZIS K %ZIS I POP S IOP=PSGION D ^%ZIS K IOP S POP=1 W !,"No device selected. Option terminated." Q
27 D EN2^PSGLBA S POP=0 I $D(IO("Q")) S PSGTIR=PSGLRTN,ZTDESC=PSGLDESC,(ZTSAVE("PSGLWARD"),ZTSAVE("PSGLWARD("),ZTSAVE("PSGTOL"))="" W ! D ENTSK^PSGTI K PSGLDESC,PSGLRTN W:$D(ZTSK) !?3,"Labels queued!"
28 Q
29 ;
30ENACP ; auto label print
31 D NOW^%DTC S PSGDT=% U IO
32 F PSGLWC=1:1:PSGLWARD F PSGLWC1=1:1:$L(PSGLWARD(PSGLWC),",") S PSGLWD=$P(PSGLWARD(PSGLWC),",",PSGLWC1),PSGLWDN=$S($D(^DIC(42,PSGLWD,0)):$P(^(0),"^"),1:"zz") F PSGOP=0:0 S PSGOP=$O(^PS(53.41,PSGTOL,1,PSGLWD,1,PSGOP)) Q:'PSGOP D AC
33 Q
34AC ;
35 N PSJFIRST,VAINDT S PSJFIRST=1
36 F PSGLWC2=1,2,3 F PSGLWC3=0:0 S PSGLWC3=$O(^PS(53.41,PSGTOL,1,PSGLWD,1,PSGOP,1,PSGLWC2,1,PSGLWC3)) Q:'PSGLWC3 S PSGORD=PSGLWC3_$E("ANV",PSGLWC2) D
37 .S:PSGTOL'=2 VAINDT=$E($P($G(^PS(53.41,PSGTOL,1,PSGLWD,1,PSGOP,1,PSGLWC2,1,PSGLWC3,0)),U,3),1,12) D ^PSGLPI
38 .I PSJFIRST D ENHEDER^PSGLPI S PSJFIRST=0
39 .I PSGLWC2=2,($P($G(^PS(53.1,+PSGORD,0)),U,9)="P") S PSGORD=+PSGORD_"P" NEW PSJFLUID S:$P(^(0),U,4)="F" PSJFLUID=1
40 .I PSGLWC2=3!$G(PSJFLUID) D EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)
41 .D:PSGLWC2'=3 ^PSGLOI
42 K DA,DIK S DA(1)=PSGTOL,DA=PSGLWD,DIK="^PS(53.41,"_PSGTOL_",1," D ^DIK
43 I '$O(^PS(53.41,PSGTOL,1,0)) K DA,DIK S DA=PSGTOL,DIK="^PS(53.41," D ^DIK
44 Q
45 ;
46DEV2 ; device for new labels
47 K IO("Q"),%ZIS,IOP S PSGION=ION,%ZIS("A")="Print on DEVICE: ",%ZIS="Q",%ZIS("B")=$P(PSJSYSL,"^",2) W ! D ^%ZIS K %ZIS I POP S IOP=PSGION D ^%ZIS K IOP S POP=1 W !,"No device selected. Option terminated." Q
48 I $D(IO("Q")) S PSGTIR="ENNLP^PSGL0",ZTDESC="LABELS" K ZTSAVE D ENTSK^PSGTI W:$D(ZTSK) !,"Labels queued!" Q
49 ;
50ENNLP ; new label print
51 D NOW^%DTC N PSJFIRST,PSJFLUID
52 S PSJFIRST=1,PSGDT=%,QT=2,QL=DUZ,PSJACNWP=1 U IO
53 F PSGOP=0:0 S PSGOP=$O(^PS(53.41,2,1,DUZ,1,PSGOP)) Q:'PSGOP D ^PSGLPI F QS=1,2,3 F QO=0:0 S QO=$O(^PS(53.41,2,1,DUZ,1,PSGOP,1,QS,1,QO)) Q:'QO D
54 . I PSJFIRST,$P($G(^PS(59.6,+$O(^PS(59.6,"B",+PSGLWD,0)),0)),U,18) D ENHEDER^PSGLPI S PSJFIRST=0
55 . S PSGORD=QO_$E("ANV",QS) I QS=2 S X=^PS(53.1,+PSGORD,0),PSJFLUID=$P(X,U,4)="F"
56 . I QS<3,'$G(PSJFLUID) D ^PSGLOI
57 . I QS=3!$G(PSJFLUID) D EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)
58 K DA,DIK S DA(1)=2,DA=DUZ,DIK="^PS(53.41,2,1," D ^DIK I '$O(^PS(53.41,2,1,0)) K DA,DIK S DA=2,DIK="^PS(53.41," D ^DIK
59 Q
60NP ;
61 R !!,"Enter an '^' to stop list, or press RETURN to continue. ",NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" *13,# Q
62 ;
63DONE ;
64 K NP,PSGOP,PSGION,QD,QS,SAVE,W,X1,X2,Z,ZTOUT D ^%ZISC
65 Q
66 ;
67ENKL ;
68 K ^PS(53.41,QT,1,QL,1,PSGOP,1,QS,1,QO)
69ENKL1 Q:$O(^PS(53.41,QT,1,QL,1,PSGOP,1,QS,1,0)) K ^PS(53.41,QT,1,QL,1,PSGOP,1,QS) Q:$O(^PS(53.41,QT,1,QL,1,PSGOP,1,0)) K ^PS(53.41,QT,1,QL,1,PSGOP) Q:$O(^PS(53.41,QT,1,QL,1,0)) K ^PS(53.41,QT,1,QL)
70 Q
71 ;
72ENCU ; clean-up
73 F QT=1,2 F QL=0:0 S QL=$O(^PS(53.41,QT,1,QL)) Q:'QL F PSGOP=0:0 S PSGOP=$O(^PS(53.41,QT,1,QL,1,PSGOP)) Q:'PSGOP F QS=1,2 D ENKL1
74 K PSGOP,QL,QS,QT Q
Note: See TracBrowser for help on using the repository browser.