Difference between revisions of "ROUTINE PSGL*31,111*"
From VistApedia
DavidWhitten (talk | contribs) (Created page with "<pre> PSGL * * 112 LINES, 5533 BYTES, RSUM: 16976215/35127952 Page 1 UCI: EHR,EHR Site: Central Regional Hospital MAY 17,2015@21:08 </pre> == PSGL^PSGL == === ...") |
DavidWhitten (talk | contribs) |
||
Line 330: | Line 330: | ||
112 +2 Q | 112 +2 Q | ||
</pre> | </pre> | ||
− | [[Category:ROUTINE | + | [[Category:ROUTINE]][[Category:ROUTINE PSGL]] |
Revision as of 01:48, 18 May 2015
PSGL * * 112 LINES, 5533 BYTES, RSUM: 16976215/35127952 Page 1 UCI: EHR,EHR Site: Central Regional Hospital MAY 17,2015@21:08
Contents
- 1 PSGL^PSGL
- 2 = PSGL^PSGL CALLS
- 3 = PSGL^PSGL LOCALS
- 4 = PSGL^PSGL GLOBALS
- 5 = PSGL^PSGL CODE
- 6 CHK^PSGL
- 7 = CHK^PSGL CALLS
- 8 = CHK^PSGL LOCALS
- 9 = CHK^PSGL GLOBALS
- 10 = CHK^PSGL CODE
- 11 ASK^PSGL
- 12 = ASK^PSGL CALLS
- 13 = ASK^PSGL LOCALS
- 14 = ASK^PSGL GLOBALS
- 15 = ASK^PSGL CODE
- 16 DONE^PSGL
- 17 = DONE^PSGL CALLS
- 18 = DONE^PSGL LOCALS
- 19 = DONE^PSGL GLOBALS
- 20 = DONE^PSGL CODE
- 21 DEV^PSGL
- 22 = DEV^PSGL CALLS
- 23 = DEV^PSGL LOCALS
- 24 = DEV^PSGL GLOBALS
- 25 = DEV^PSGL CODE
- 26 G^PSGL
- 27 = G^PSGL CALLS
- 28 = G^PSGL LOCALS
- 29 = G^PSGL GLOBALS
- 30 = G^PSGL CODE
- 31 W^PSGL
- 32 = W^PSGL CALLS
- 33 = W^PSGL LOCALS
- 34 = W^PSGL GLOBALS
- 35 = W^PSGL CODE
- 36 P^PSGL
- 37 = P^PSGL CALLS
- 38 = P^PSGL LOCALS
- 39 = P^PSGL GLOBALS
- 40 = P^PSGL CODE
- 41 C^PSGL
- 42 = C^PSGL CALLS
- 43 = C^PSGL LOCALS
- 44 = C^PSGL GLOBALS
- 45 = C^PSGL CODE
- 46 CDIC^PSGL
- 47 = CDIC^PSGL CALLS
- 48 = CDIC^PSGL LOCALS
- 49 = CDIC^PSGL GLOBALS
- 50 = CDIC^PSGL CODE
- 51 L^PSGL
- 52 = L^PSGL CALLS
- 53 = L^PSGL LOCALS
- 54 = L^PSGL GLOBALS
- 55 = L^PSGL CODE
- 56 LDIC^PSGL
- 57 = LDIC^PSGL CALLS
- 58 = LDIC^PSGL LOCALS
- 59 = LDIC^PSGL GLOBALS
- 60 = LDIC^PSGL CODE
- 61 ENG^PSGL
- 62 = ENG^PSGL CALLS
- 63 = ENG^PSGL LOCALS
- 64 = ENG^PSGL GLOBALS
- 65 = ENG^PSGL CODE
- 66 ENW^PSGL
- 67 = ENW^PSGL CALLS
- 68 = ENW^PSGL LOCALS
- 69 = ENW^PSGL GLOBALS
- 70 = ENW^PSGL CODE
- 71 ENW1^PSGL
- 72 = ENW1^PSGL CALLS
- 73 = ENW1^PSGL LOCALS
- 74 = ENW1^PSGL GLOBALS
- 75 = ENW1^PSGL CODE
- 76 IWP^PSGL
- 77 = IWP^PSGL CALLS
- 78 = IWP^PSGL LOCALS
- 79 = IWP^PSGL GLOBALS
- 80 = IWP^PSGL CODE
- 81 ENL^PSGL
- 82 = ENL^PSGL CALLS
- 83 = ENL^PSGL LOCALS
- 84 = ENL^PSGL GLOBALS
- 85 = ENL^PSGL CODE
- 86 ENC^PSGL
- 87 = ENC^PSGL CALLS
- 88 = ENC^PSGL LOCALS
- 89 = ENC^PSGL GLOBALS
- 90 = ENC^PSGL CODE
- 91 ENP^PSGL
- 92 = ENP^PSGL CALLS
- 93 = ENP^PSGL LOCALS
- 94 = ENP^PSGL GLOBALS
- 95 = ENP^PSGL CODE
- 96 ENPLP^PSGL
- 97 = ENPLP^PSGL CALLS
- 98 = ENPLP^PSGL LOCALS
- 99 = ENPLP^PSGL GLOBALS
- 100 = ENPLP^PSGL CODE
- 101 DT^PSGL
- 102 = DT^PSGL CALLS
- 103 = DT^PSGL LOCALS
- 104 = DT^PSGL GLOBALS
- 105 = DT^PSGL CODE
- 106 KL^PSGL
- 107 = KL^PSGL CALLS
- 108 = KL^PSGL LOCALS
- 109 = KL^PSGL GLOBALS
- 110 = KL^PSGL CODE
PSGL^PSGL
PSGL^PSGL INTEGRATION AGREEMENTS
= PSGL^PSGL CALLS
= PSGL^PSGL LOCALS
= PSGL^PSGL GLOBALS
= PSGL^PSGL CODE
1 PSGL ;BIR/CML3-LABEL PRINT/REPRINT ;25 SEP 97 / 7:41 AM 2 +1 ;;5.0; INPATIENT MEDICATIONS ;**31,111**;16 DEC 97 3 +2 ; 4 +3 ; Reference to ^PS(55 is supported by DBIA# 2191 5 +4 ; 6 +5 N PSGPTMP,PSJNEW,PPAGE,PSGEFN S PSJNEW=1 7 +6 D ENCV^PSGSETU Q:$D(XQUIT) K PSGLSTOP S %=1 F PSGTOL=1,3 I $O(^PS( 53.41,PSGTOL,1,0)) D ENACL^PSGL0 8 +7 G:%<0 DONE
CHK^PSGL
CHK^PSGL INTEGRATION AGREEMENTS
= CHK^PSGL CALLS
= CHK^PSGL LOCALS
= CHK^PSGL GLOBALS
= CHK^PSGL CODE
9 CHK ; 10 +1 I '$O(^PS(53.41,2,1,DUZ,1,0)) G ASK 11 +2 F W !!,"You have unprinted new labels. Do you want them now" S %= 1 D YN^DICN Q:% D CHKM^PSGLH 12 +3 G:%<0 DONE I %=1 D ENNL^PSGL0 G ASK 13 +4 F W !!,"Will you want them later" S %=1 D YN^DICN Q:% D LM^PSGLH 14 +5 G:%<0 DONE I %=2 S DIK="^PS(53.41,2,1,",DA=DUZ,DA(1)=2 D ^DIK 15 +6 ;
ASK^PSGL
ASK^PSGL INTEGRATION AGREEMENTS
= ASK^PSGL CALLS
= ASK^PSGL LOCALS
= ASK^PSGL GLOBALS
= ASK^PSGL CODE
16 ASK ; 17 +1 S PSGSSH="LBL" F D ^PSGSEL Q:"^"[PSGSS K PSGLWD,PSGLWG S PSGPTMP= 0,PPAGE=1 D @PSGSS Q:+Y'>0 K ZTSAVE,IO("Q") S POP=0,Y=1 D:PSGSS'= "P" DT Q:Y'>0 D:PSGSS'="P" DEV Q:POP!$D(IO("Q")) D @("EN"_PSGSS) D ^%ZISC 18 +2 ;
DONE^PSGL
DONE^PSGL INTEGRATION AGREEMENTS
= DONE^PSGL CALLS
= DONE^PSGL LOCALS
= DONE^PSGL GLOBALS
= DONE^PSGL CODE
19 DONE ; 20 +1 D ENKV^PSGSETU K CF,DFN,NG,OD,ON,PSGCNT,PSGLMT,PSGODDD,PSGOL,PSGON, PSGOP,PSGORD,PSGODT,PSGSS,PSGPL1,PSGPL2,PSGPL3,PSGSSH,PSIVREA,PSJO N,PSJOL,PSJORD,PSJIVOF,PSJOCNT,PSJON,RF,QO,QS,QSD,Q1,Q2,WG,ZTSAVE 21 +2 K ORPV,ORSTOP,ORSTRT,ORSTS,P17 Q 22 +3 ;
DEV^PSGL
DEV^PSGL INTEGRATION AGREEMENTS
= DEV^PSGL CALLS
= DEV^PSGL LOCALS
= DEV^PSGL GLOBALS
= DEV^PSGL CODE
23 DEV ; 24 +1 K ZTSK,%ZIS,IOP,IO("Q") S PSGION=ION,%ZIS="Q",%ZIS("A")="Label Prin ting Device: ",%ZIS("B")=$P(PSJSYSL,"^",2) W ! D ^%ZIS K %ZIS I PO P S IOP=PSGION D ^%ZIS K IOP S POP=1 W !?3,"(No device chosen for label print.)" Q 25 +2 D EN2^PSGLBA S POP=0 Q:'$D(IO("Q")) 26 +3 S ZTDESC="UD LABEL PRINT",PSGTIR=$S(PSGSS'="P":"EN"_PSGSS,1:"ENPLP" )_"^PSGL" I PSGSS="G" F X="PSGLBLD","PSGLWG","PSGLWGN" S ZTSAVE(X) ="" 27 +4 I PSGSS="W" F X="PSGLBLD","PSGLWD","PSGLWDN" S ZTSAVE(X)="" 28 +5 I PSGSS="P" F X="PSGP","PSGP(0)","PSJPAGE","PSJPDOB","PSJPDX","PSJP RB","PSJPSEX","PSJPSSN","PSJPWD","PSJPWDN","PSGODDD","PSGODDD(","V A(""PID"")","VA(""BID"")","^TMP(""PSJON"",$J," S ZTSAVE(X)="" 29 +6 W ! D ENTSK^PSGTI W !,"Labels ",$S($D(ZTSK):"",1:"NOT "),"queued!" 30 +7 Q 31 +8 ;
G^PSGL
G^PSGL INTEGRATION AGREEMENTS
= G^PSGL CALLS
= G^PSGL LOCALS
= G^PSGL GLOBALS
= G^PSGL CODE
32 G ; 33 +1 K DIC S DIC="^PS(57.5,",DIC(0)="QEAMIZ",DIC("A")="Select WARD GROUP : " W ! D ^DIC K DIC D Q 34 +2 . I X="^OTHER" S (PSGLWG,PSGLWGN)="^OTHER",Y=1 Q 35 +3 . I Y>0 S PSGLWG=+Y,PSGLWGN=Y(0,0) 36 +4 ;
W^PSGL
W^PSGL INTEGRATION AGREEMENTS
= W^PSGL CALLS
= W^PSGL LOCALS
= W^PSGL GLOBALS
= W^PSGL CODE
37 W ; 38 +1 K DIC S DIC="^DIC(42,",DIC(0)="QEAMIZ",DIC("A")="Select WARD: " W ! D ^DIC K DIC S:Y>0 PSGLWD=+Y,PSGLWDN=Y(0,0) Q 39 +2 ;
P^PSGL
P^PSGL INTEGRATION AGREEMENTS
= P^PSGL CALLS
= P^PSGL LOCALS
= P^PSGL GLOBALS
= P^PSGL CODE
40 P ; 41 +1 K PSJPR D ^PSJP S Y=PSGP Q 42 +2 ;
C^PSGL
C^PSGL INTEGRATION AGREEMENTS
= C^PSGL CALLS
= C^PSGL LOCALS
= C^PSGL GLOBALS
= C^PSGL CODE
43 C ; 44 +1 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: " 45 +2 S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
CDIC^PSGL
CDIC^PSGL INTEGRATION AGREEMENTS
= CDIC^PSGL CALLS
= CDIC^PSGL LOCALS
= CDIC^PSGL GLOBALS
= CDIC^PSGL CODE
46 CDIC ; 47 +1 K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y 48 +2 W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",! 49 +3 Q
L^PSGL
L^PSGL INTEGRATION AGREEMENTS
= L^PSGL CALLS
= L^PSGL LOCALS
= L^PSGL GLOBALS
= L^PSGL CODE
50 L ; 51 +1 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: " 52 +2 S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
LDIC^PSGL
LDIC^PSGL INTEGRATION AGREEMENTS
= LDIC^PSGL CALLS
= LDIC^PSGL LOCALS
= LDIC^PSGL GLOBALS
= LDIC^PSGL CODE
53 LDIC ; 54 +1 K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y 55 +2 W:X["?" !!,"Enter the name of the clinic group you want to use to s elect patients for processing." 56 +3 Q
ENG^PSGL
ENG^PSGL INTEGRATION AGREEMENTS
= ENG^PSGL CALLS
= ENG^PSGL LOCALS
= ENG^PSGL GLOBALS
= ENG^PSGL CODE
57 ENG ; 58 +1 F PSGLWD=0:0 S PSGLWD=$O(^PS(57.5,"AC",PSGLWG,PSGLWD)) Q:'PSGLWD S PSGLWDN=$P($G(^DIC(42,PSGLWD,0)),"^") D ENW1 59 +2 Q 60 +3 ;
ENW^PSGL
ENW^PSGL INTEGRATION AGREEMENTS
= ENW^PSGL CALLS
= ENW^PSGL LOCALS
= ENW^PSGL GLOBALS
= ENW^PSGL CODE
61 ENW ; 62 +1 S PSGLWG=$O(^PS(57.5,"AB",PSGLWD,0)),PSGLWGN="" I PSGLWG,$D(^PS(57. 5,PSGLWG,0)),$P(^(0),"^")]"" S PSGLWG=$P(^(0),"^") 63 +2 ;
ENW1^PSGL
ENW1^PSGL INTEGRATION AGREEMENTS
= ENW1^PSGL CALLS
= ENW1^PSGL LOCALS
= ENW1^PSGL GLOBALS
= ENW1^PSGL CODE
64 ENW1 ; 65 +1 D NOW^%DTC S PSGDT=% U IO F PSGOP=0:0 S (DFN,PSGOP,PSGP)=$O(^DPT("C N",PSGLWDN,PSGOP)) Q:'PSGOP D IWP 66 +2 Q
IWP^PSGL
IWP^PSGL INTEGRATION AGREEMENTS
= IWP^PSGL CALLS
= IWP^PSGL LOCALS
= IWP^PSGL GLOBALS
= IWP^PSGL CODE
67 IWP ; 68 +1 N PSJFIRST,PSJACND S (PSJACND,PSJFIRST)=1 K PSJACNWP D ^PSJAC,ENPVS ET^PSGLPI 69 +2 F QSD=PSGLAD:0 S QSD=$O(^PS(55,PSGOP,5,"AUS",QSD)) Q:'QSD F ON=0:0 S ON=$O(^PS(55,PSGOP,5,"AUS",QSD,ON)) Q:'ON D 70 +3 .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 71 +4 .I $D(^PS(55,PSGOP,5,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"A" D ^PSGLO I,KL 72 +5 F ON=0:0 S ON=$O(^PS(53.1,"AC",PSGOP,ON)) Q:'ON D 73 +6 .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 74 +7 .I $D(^PS(53.1,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"N" D ^PSGLOI,KL 75 +8 Q 76 +9 ;
ENL^PSGL
ENL^PSGL INTEGRATION AGREEMENTS
= ENL^PSGL CALLS
= ENL^PSGL LOCALS
= ENL^PSGL GLOBALS
= ENL^PSGL CODE
77 ENL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D ENC 78 +1 Q
ENC^PSGL
ENC^PSGL INTEGRATION AGREEMENTS
= ENC^PSGL CALLS
= ENC^PSGL LOCALS
= ENC^PSGL GLOBALS
= ENC^PSGL CODE
79 ENC ; 80 +1 K ^TMP("PSJCI",$J) 81 +2 S STDTE=0 F S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:'STDTE S CLINIC=0 F S CLINIC=$O(^PS(55,"AUDC",STDTE,CLINIC)) Q:'CLINIC D 82 +3 . S JDFN=0 F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:'JDFN S ^TMP("PSJCI",$J,JDFN)="" 83 +4 S DFN="" F S DFN=$O(^TMP("PSJCI",$J,DFN)) Q:'DFN S (PSGOP,PSGP)=D FN D IWP 84 +5 Q
ENP^PSGL
ENP^PSGL INTEGRATION AGREEMENTS
= ENP^PSGL CALLS
= ENP^PSGL LOCALS
= ENP^PSGL GLOBALS
= ENP^PSGL CODE
85 ENP ; 86 +1 ;D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11),PSGLPF=1 D ^ PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON 87 +2 D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11) D ^PSJO K PSG LPF Q:'PSJON S PSGLMT=PSJON 88 +3 F R !!,"Select orders for labels: ",X:DTIME W:'$T $C(7) S:'$T X="^ " Q:"^"[X D Q:$D(X) 89 +4 .I X?2."?" D H2^PSGON K X Q 90 +5 .I X?1."?" W !!?2,"Select the orders for which you want labels prin ted." K X Q 91 +6 .I X="A" D AADR^PSJUTL K X Q 92 +7 .I X'?1."?" D ^PSGON W:'$D(X) $C(7)," ??" Q 93 +8 I "^"[X K ^TMP("PSJON",$J) Q 94 +9 D DEV I POP!$D(IO("Q")) K ^TMP("PSJON",$J) Q 95 +10 ;
ENPLP^PSGL
ENPLP^PSGL INTEGRATION AGREEMENTS
= ENPLP^PSGL CALLS
= ENPLP^PSGL LOCALS
= ENPLP^PSGL GLOBALS
= ENPLP^PSGL CODE
96 ENPLP ; 97 +1 D NOW^%DTC S PSGDT=+$E(%,1,12),(DFN,PSGOP)=PSGP D:$D(ZTSK) ^PSJAC D ENPVSET^PSGLPI U IO 98 +2 N PSJFIRST S PSJFIRST=1 F PSGPL1=1:1:PSGODDD F PSGPL2=1:1 S PSGPL3= $P(PSGODDD(PSGPL1),",",PSGPL2) Q:'PSGPL3 S (PSGORD,PSJORD)=^TMP(" PSJON",$J,PSGPL3) D 99 +3 .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 100 +4 .I PSGORD["V" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q 101 +5 .I PSGORD'["P" D ^PSGLOI,KL Q 102 +6 .S X=$P($G(^PS(53.1,+PSGORD,0)),"^",4) I X="F" D EN^PSIVUDL(DFN,PSG ORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q 103 +7 .D ^PSGLOI,KL 104 +8 Q 105 +9 ;
DT^PSGL
DT^PSGL INTEGRATION AGREEMENTS
= DT^PSGL CALLS
= DT^PSGL LOCALS
= DT^PSGL GLOBALS
= DT^PSGL CODE
106 DT ; 107 +1 F K %DT S %DT="ET",%DT(0)="-NOW" R !!,"Enter label start date: ",X :DTIME D:X?1."?" DTM^PSGLH D ^%DT K %DT I Y>0!("^"[X) S PSGLBLD=Y, ZTSAVE("PSGLBLD")="" Q 108 +2 W:Y'>0 $C(7),!?3,"(No date selected for label print.)" Q 109 +3 ;
KL^PSGL
KL^PSGL INTEGRATION AGREEMENTS
= KL^PSGL CALLS
= KL^PSGL LOCALS
= KL^PSGL GLOBALS
= KL^PSGL CODE
110 KL ; kill other label records for the same order 111 +1 S QS=$S(PSGORD["V":3,PSGORD["N":2,1:1) K ^PS(53.41,2,1,DUZ,1,PSGOP, 1,QS,+PSGORD) 112 +2 Q