Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGL

PSGL.m

Go to the documentation of this file.
  1. PSGL ;BIR/CML3-LABEL PRINT/REPRINT ;25 SEP 97 / 7:41 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;**31,111**;16 DEC 97
  1. ;
  1. ; Reference to ^PS(55 is supported by DBIA# 2191
  1. ;
  1. N PSGPTMP,PSJNEW,PPAGE,PSGEFN S PSJNEW=1
  1. 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
  1. G:%<0 DONE
  1. CHK ;
  1. I '$O(^PS(53.41,2,1,DUZ,1,0)) G ASK
  1. F W !!,"You have unprinted new labels. Do you want them now" S %=1 D YN^DICN Q:% D CHKM^PSGLH
  1. G:%<0 DONE I %=1 D ENNL^PSGL0 G ASK
  1. F W !!,"Will you want them later" S %=1 D YN^DICN Q:% D LM^PSGLH
  1. G:%<0 DONE I %=2 S DIK="^PS(53.41,2,1,",DA=DUZ,DA(1)=2 D ^DIK
  1. ;
  1. ASK ;
  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
  1. ;
  1. DONE ;
  1. D ENKV^PSGSETU K CF,DFN,NG,OD,ON,PSGCNT,PSGLMT,PSGODDD,PSGOL,PSGON,PSGOP,PSGORD,PSGODT,PSGSS,PSGPL1,PSGPL2,PSGPL3,PSGSSH,PSIVREA,PSJON,PSJOL,PSJORD,PSJIVOF,PSJOCNT,PSJON,RF,QO,QS,QSD,Q1,Q2,WG,ZTSAVE
  1. K ORPV,ORSTOP,ORSTRT,ORSTS,P17 Q
  1. ;
  1. DEV ;
  1. K ZTSK,%ZIS,IOP,IO("Q") 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 !?3,"(No device chosen for label print.)" Q
  1. D EN2^PSGLBA S POP=0 Q:'$D(IO("Q"))
  1. 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)=""
  1. I PSGSS="W" F X="PSGLBLD","PSGLWD","PSGLWDN" S ZTSAVE(X)=""
  1. I PSGSS="P" F X="PSGP","PSGP(0)","PSJPAGE","PSJPDOB","PSJPDX","PSJPRB","PSJPSEX","PSJPSSN","PSJPWD","PSJPWDN","PSGODDD","PSGODDD(","VA(""PID"")","VA(""BID"")","^TMP(""PSJON"",$J," S ZTSAVE(X)=""
  1. W ! D ENTSK^PSGTI W !,"Labels ",$S($D(ZTSK):"",1:"NOT "),"queued!"
  1. Q
  1. ;
  1. G ;
  1. K DIC S DIC="^PS(57.5,",DIC(0)="QEAMIZ",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC D Q
  1. . I X="^OTHER" S (PSGLWG,PSGLWGN)="^OTHER",Y=1 Q
  1. . I Y>0 S PSGLWG=+Y,PSGLWGN=Y(0,0)
  1. ;
  1. W ;
  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
  1. ;
  1. P ;
  1. K PSJPR D ^PSJP S Y=PSGP Q
  1. ;
  1. C ;
  1. K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
  1. S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
  1. CDIC ;
  1. K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
  1. W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
  1. Q
  1. L ;
  1. K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
  1. S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
  1. LDIC ;
  1. K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
  1. W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
  1. Q
  1. ENG ;
  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
  1. Q
  1. ;
  1. ENW ;
  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),"^")
  1. ;
  1. ENW1 ;
  1. D NOW^%DTC S PSGDT=% U IO F PSGOP=0:0 S (DFN,PSGOP,PSGP)=$O(^DPT("CN",PSGLWDN,PSGOP)) Q:'PSGOP D IWP
  1. Q
  1. IWP ;
  1. N PSJFIRST,PSJACND S (PSJACND,PSJFIRST)=1 K PSJACNWP D ^PSJAC,ENPVSET^PSGLPI
  1. 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
  1. .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
  1. .I $D(^PS(55,PSGOP,5,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"A" D ^PSGLOI,KL
  1. F ON=0:0 S ON=$O(^PS(53.1,"AC",PSGOP,ON)) Q:'ON D
  1. .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
  1. .I $D(^PS(53.1,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"N" D ^PSGLOI,KL
  1. Q
  1. ;
  1. ENL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D ENC
  1. Q
  1. ENC ;
  1. K ^TMP("PSJCI",$J)
  1. 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
  1. . S JDFN=0 F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:'JDFN S ^TMP("PSJCI",$J,JDFN)=""
  1. S DFN="" F S DFN=$O(^TMP("PSJCI",$J,DFN)) Q:'DFN S (PSGOP,PSGP)=DFN D IWP
  1. Q
  1. ENP ;
  1. ;D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11),PSGLPF=1 D ^PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON
  1. D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11) D ^PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON
  1. F R !!,"Select orders for labels: ",X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D Q:$D(X)
  1. .I X?2."?" D H2^PSGON K X Q
  1. .I X?1."?" W !!?2,"Select the orders for which you want labels printed." K X Q
  1. .I X="A" D AADR^PSJUTL K X Q
  1. .I X'?1."?" D ^PSGON W:'$D(X) $C(7)," ??" Q
  1. I "^"[X K ^TMP("PSJON",$J) Q
  1. D DEV I POP!$D(IO("Q")) K ^TMP("PSJON",$J) Q
  1. ;
  1. ENPLP ;
  1. D NOW^%DTC S PSGDT=+$E(%,1,12),(DFN,PSGOP)=PSGP D:$D(ZTSK) ^PSJAC D ENPVSET^PSGLPI U IO
  1. 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
  1. .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
  1. .I PSGORD["V" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q
  1. .I PSGORD'["P" D ^PSGLOI,KL Q
  1. .S X=$P($G(^PS(53.1,+PSGORD,0)),"^",4) I X="F" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q
  1. .D ^PSGLOI,KL
  1. Q
  1. ;
  1. DT ;
  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
  1. W:Y'>0 $C(7),!?3,"(No date selected for label print.)" Q
  1. ;
  1. KL ; kill other label records for the same order
  1. S QS=$S(PSGORD["V":3,PSGORD["N":2,1:1) K ^PS(53.41,2,1,DUZ,1,PSGOP,1,QS,+PSGORD)
  1. Q