- PSGL ;BIR/CML3-LABEL PRINT/REPRINT ;25 SEP 97 / 7:41 AM
- ;;5.0; INPATIENT MEDICATIONS ;**31,111**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191
- ;
- N PSGPTMP,PSJNEW,PPAGE,PSGEFN S PSJNEW=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
- G:%<0 DONE
- CHK ;
- I '$O(^PS(53.41,2,1,DUZ,1,0)) G ASK
- F W !!,"You have unprinted new labels. Do you want them now" S %=1 D YN^DICN Q:% D CHKM^PSGLH
- G:%<0 DONE I %=1 D ENNL^PSGL0 G ASK
- F W !!,"Will you want them later" S %=1 D YN^DICN Q:% D LM^PSGLH
- G:%<0 DONE I %=2 S DIK="^PS(53.41,2,1,",DA=DUZ,DA(1)=2 D ^DIK
- ;
- ASK ;
- 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
- ;
- DONE ;
- 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
- K ORPV,ORSTOP,ORSTRT,ORSTS,P17 Q
- ;
- DEV ;
- 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
- D EN2^PSGLBA S POP=0 Q:'$D(IO("Q"))
- 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)=""
- I PSGSS="W" F X="PSGLBLD","PSGLWD","PSGLWDN" S ZTSAVE(X)=""
- 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)=""
- W ! D ENTSK^PSGTI W !,"Labels ",$S($D(ZTSK):"",1:"NOT "),"queued!"
- Q
- ;
- G ;
- K DIC S DIC="^PS(57.5,",DIC(0)="QEAMIZ",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC D Q
- . I X="^OTHER" S (PSGLWG,PSGLWGN)="^OTHER",Y=1 Q
- . I Y>0 S PSGLWG=+Y,PSGLWGN=Y(0,0)
- ;
- W ;
- 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
- ;
- P ;
- K PSJPR D ^PSJP S Y=PSGP Q
- ;
- C ;
- K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
- S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
- CDIC ;
- K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
- W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
- Q
- L ;
- K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
- S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
- LDIC ;
- K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
- W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
- Q
- ENG ;
- 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
- Q
- ;
- ENW ;
- S PSGLWG=$O(^PS(57.5,"AB",PSGLWD,0)),PSGLWGN="" I PSGLWG,$D(^PS(57.5,PSGLWG,0)),$P(^(0),"^")]"" S PSGLWG=$P(^(0),"^")
- ;
- ENW1 ;
- D NOW^%DTC S PSGDT=% U IO F PSGOP=0:0 S (DFN,PSGOP,PSGP)=$O(^DPT("CN",PSGLWDN,PSGOP)) Q:'PSGOP D IWP
- Q
- IWP ;
- N PSJFIRST,PSJACND S (PSJACND,PSJFIRST)=1 K PSJACNWP D ^PSJAC,ENPVSET^PSGLPI
- 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
- .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
- .I $D(^PS(55,PSGOP,5,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"A" D ^PSGLOI,KL
- F ON=0:0 S ON=$O(^PS(53.1,"AC",PSGOP,ON)) Q:'ON D
- .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
- .I $D(^PS(53.1,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"N" D ^PSGLOI,KL
- Q
- ;
- ENL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D ENC
- Q
- ENC ;
- K ^TMP("PSJCI",$J)
- 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
- . S JDFN=0 F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:'JDFN S ^TMP("PSJCI",$J,JDFN)=""
- S DFN="" F S DFN=$O(^TMP("PSJCI",$J,DFN)) Q:'DFN S (PSGOP,PSGP)=DFN D IWP
- Q
- ENP ;
- ;D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11),PSGLPF=1 D ^PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON
- D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11) D ^PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON
- F R !!,"Select orders for labels: ",X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D Q:$D(X)
- .I X?2."?" D H2^PSGON K X Q
- .I X?1."?" W !!?2,"Select the orders for which you want labels printed." K X Q
- .I X="A" D AADR^PSJUTL K X Q
- .I X'?1."?" D ^PSGON W:'$D(X) $C(7)," ??" Q
- I "^"[X K ^TMP("PSJON",$J) Q
- D DEV I POP!$D(IO("Q")) K ^TMP("PSJON",$J) Q
- ;
- ENPLP ;
- D NOW^%DTC S PSGDT=+$E(%,1,12),(DFN,PSGOP)=PSGP D:$D(ZTSK) ^PSJAC D ENPVSET^PSGLPI U IO
- 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
- .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
- .I PSGORD["V" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q
- .I PSGORD'["P" D ^PSGLOI,KL Q
- .S X=$P($G(^PS(53.1,+PSGORD,0)),"^",4) I X="F" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q
- .D ^PSGLOI,KL
- Q
- ;
- DT ;
- 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
- W:Y'>0 $C(7),!?3,"(No date selected for label print.)" Q
- ;
- KL ; kill other label records for the same order
- S QS=$S(PSGORD["V":3,PSGORD["N":2,1:1) K ^PS(53.41,2,1,DUZ,1,PSGOP,1,QS,+PSGORD)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGL 5533 printed Jan 18, 2025@03:02:34 Page 2
- PSGL ;BIR/CML3-LABEL PRINT/REPRINT ;25 SEP 97 / 7:41 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**31,111**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191
- +4 ;
- +5 NEW PSGPTMP,PSJNEW,PPAGE,PSGEFN
- SET PSJNEW=1
- +6 DO ENCV^PSGSETU
- if $DATA(XQUIT)
- QUIT
- KILL PSGLSTOP
- SET %=1
- FOR PSGTOL=1,3
- IF $ORDER(^PS(53.41,PSGTOL,1,0))
- DO ENACL^PSGL0
- +7 if %<0
- GOTO DONE
- CHK ;
- +1 IF '$ORDER(^PS(53.41,2,1,DUZ,1,0))
- GOTO ASK
- +2 FOR
- WRITE !!,"You have unprinted new labels. Do you want them now"
- SET %=1
- DO YN^DICN
- if %
- QUIT
- DO CHKM^PSGLH
- +3 if %<0
- GOTO DONE
- IF %=1
- DO ENNL^PSGL0
- GOTO ASK
- +4 FOR
- WRITE !!,"Will you want them later"
- SET %=1
- DO YN^DICN
- if %
- QUIT
- DO LM^PSGLH
- +5 if %<0
- GOTO DONE
- IF %=2
- SET DIK="^PS(53.41,2,1,"
- SET DA=DUZ
- SET DA(1)=2
- DO ^DIK
- +6 ;
- ASK ;
- +1 SET PSGSSH="LBL"
- FOR
- DO ^PSGSEL
- if "^"[PSGSS
- QUIT
- KILL PSGLWD,PSGLWG
- SET PSGPTMP=0
- SET PPAGE=1
- DO @PSGSS
- if +Y'>0
- QUIT
- KILL ZTSAVE,IO("Q")
- SET POP=0
- SET Y=1
- if PSGSS'="P"
- DO DT
- if Y'>0
- QUIT
- if PSGSS'="P"
- DO DEV
- if POP!$DATA(IO("Q"))
- QUIT
- DO @("EN"_PSGSS)
- DO ^%ZISC
- +2 ;
- DONE ;
- +1 DO ENKV^PSGSETU
- KILL 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
- +2 KILL ORPV,ORSTOP,ORSTRT,ORSTS,P17
- QUIT
- +3 ;
- DEV ;
- +1 KILL ZTSK,%ZIS,IOP,IO("Q")
- SET PSGION=ION
- SET %ZIS="Q"
- SET %ZIS("A")="Label Printing Device: "
- SET %ZIS("B")=$PIECE(PSJSYSL,"^",2)
- WRITE !
- DO ^%ZIS
- KILL %ZIS
- IF POP
- SET IOP=PSGION
- DO ^%ZIS
- KILL IOP
- SET POP=1
- WRITE !?3,"(No device chosen for label print.)"
- QUIT
- +2 DO EN2^PSGLBA
- SET POP=0
- if '$DATA(IO("Q"))
- QUIT
- +3 SET ZTDESC="UD LABEL PRINT"
- SET PSGTIR=$SELECT(PSGSS'="P":"EN"_PSGSS,1:"ENPLP")_"^PSGL"
- IF PSGSS="G"
- FOR X="PSGLBLD","PSGLWG","PSGLWGN"
- SET ZTSAVE(X)=""
- +4 IF PSGSS="W"
- FOR X="PSGLBLD","PSGLWD","PSGLWDN"
- SET ZTSAVE(X)=""
- +5 IF PSGSS="P"
- FOR X="PSGP","PSGP(0)","PSJPAGE","PSJPDOB","PSJPDX","PSJPRB","PSJPSEX","PSJPSSN","PSJPWD","PSJPWDN","PSGODDD","PSGODDD(","VA(""PID"")","VA(""BID"")","^TMP(""PSJON"",$J,"
- SET ZTSAVE(X)=""
- +6 WRITE !
- DO ENTSK^PSGTI
- WRITE !,"Labels ",$SELECT($DATA(ZTSK):"",1:"NOT "),"queued!"
- +7 QUIT
- +8 ;
- G ;
- +1 KILL DIC
- SET DIC="^PS(57.5,"
- SET DIC(0)="QEAMIZ"
- SET DIC("A")="Select WARD GROUP: "
- WRITE !
- DO ^DIC
- KILL DIC
- Begin DoDot:1
- +2 IF X="^OTHER"
- SET (PSGLWG,PSGLWGN)="^OTHER"
- SET Y=1
- QUIT
- +3 IF Y>0
- SET PSGLWG=+Y
- SET PSGLWGN=Y(0,0)
- End DoDot:1
- QUIT
- +4 ;
- W ;
- +1 KILL DIC
- SET DIC="^DIC(42,"
- SET DIC(0)="QEAMIZ"
- SET DIC("A")="Select WARD: "
- WRITE !
- DO ^DIC
- KILL DIC
- if Y>0
- SET PSGLWD=+Y
- SET PSGLWDN=Y(0,0)
- QUIT
- +2 ;
- P ;
- +1 KILL PSJPR
- DO ^PSJP
- SET Y=PSGP
- QUIT
- +2 ;
- C ;
- +1 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select CLINIC: "
- +2 SET DIR("?")="^D CDIC^PSGVBW"
- WRITE !
- DO ^DIR
- CDIC ;
- +1 KILL DIC
- SET DIC="^SC("
- SET DIC(0)="QEMIZ"
- DO ^DIC
- KILL DIC
- if +Y>0
- SET CL=+Y
- +2 if X["?"
- WRITE !!,"Enter the clinic you want to use to select patients for processing.",!
- +3 QUIT
- L ;
- +1 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select CLINIC GROUP: "
- +2 SET DIR("?")="^D LDIC^PSGVBW"
- WRITE !
- DO ^DIR
- LDIC ;
- +1 KILL DIC
- SET DIC="^PS(57.8,"
- SET DIC(0)="QEMI"
- DO ^DIC
- KILL DIC
- if +Y>0
- SET CG=+Y
- +2 if X["?"
- WRITE !!,"Enter the name of the clinic group you want to use to select patients for processing."
- +3 QUIT
- ENG ;
- +1 FOR PSGLWD=0:0
- SET PSGLWD=$ORDER(^PS(57.5,"AC",PSGLWG,PSGLWD))
- if 'PSGLWD
- QUIT
- SET PSGLWDN=$PIECE($GET(^DIC(42,PSGLWD,0)),"^")
- DO ENW1
- +2 QUIT
- +3 ;
- ENW ;
- +1 SET PSGLWG=$ORDER(^PS(57.5,"AB",PSGLWD,0))
- SET PSGLWGN=""
- IF PSGLWG
- IF $DATA(^PS(57.5,PSGLWG,0))
- IF $PIECE(^(0),"^")]""
- SET PSGLWG=$PIECE(^(0),"^")
- +2 ;
- ENW1 ;
- +1 DO NOW^%DTC
- SET PSGDT=%
- USE IO
- FOR PSGOP=0:0
- SET (DFN,PSGOP,PSGP)=$ORDER(^DPT("CN",PSGLWDN,PSGOP))
- if 'PSGOP
- QUIT
- DO IWP
- +2 QUIT
- IWP ;
- +1 NEW PSJFIRST,PSJACND
- SET (PSJACND,PSJFIRST)=1
- KILL PSJACNWP
- DO ^PSJAC
- DO ENPVSET^PSGLPI
- +2 FOR QSD=PSGLAD:0
- SET QSD=$ORDER(^PS(55,PSGOP,5,"AUS",QSD))
- if 'QSD
- QUIT
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,PSGOP,5,"AUS",QSD,ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +3 IF PSJFIRST
- IF $PIECE(PSJSYSW0,U,18)
- DO ENHEDER^PSGLPI
- SET PSJFIRST=0
- +4 IF $DATA(^PS(55,PSGOP,5,ON,7))
- IF +^(7)'<PSGLBLD
- SET PSGORD=ON_"A"
- DO ^PSGLOI
- DO KL
- End DoDot:1
- +5 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AC",PSGOP,ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +6 IF PSJFIRST
- IF $PIECE(PSJSYSW0,U,18)
- DO ENHEDER^PSGLPI
- SET PSJFIRST=0
- +7 IF $DATA(^PS(53.1,ON,7))
- IF +^(7)'<PSGLBLD
- SET PSGORD=ON_"N"
- DO ^PSGLOI
- DO KL
- End DoDot:1
- +8 QUIT
- +9 ;
- ENL SET CL=""
- FOR
- SET CL=$ORDER(^PS(57.8,"AD",CG,CL))
- if CL=""
- QUIT
- DO ENC
- +1 QUIT
- ENC ;
- +1 KILL ^TMP("PSJCI",$JOB)
- +2 SET STDTE=0
- FOR
- SET STDTE=$ORDER(^PS(55,"AUDC",STDTE))
- if 'STDTE
- QUIT
- SET CLINIC=0
- FOR
- SET CLINIC=$ORDER(^PS(55,"AUDC",STDTE,CLINIC))
- if 'CLINIC
- QUIT
- Begin DoDot:1
- +3 SET JDFN=0
- FOR
- SET JDFN=$ORDER(^PS(55,"AUDC",STDTE,CLINIC,JDFN))
- if 'JDFN
- QUIT
- SET ^TMP("PSJCI",$JOB,JDFN)=""
- End DoDot:1
- +4 SET DFN=""
- FOR
- SET DFN=$ORDER(^TMP("PSJCI",$JOB,DFN))
- if 'DFN
- QUIT
- SET (PSGOP,PSGP)=DFN
- DO IWP
- +5 QUIT
- ENP ;
- +1 ;D ENL^PSJO3 Q:"^N"[PSJOL S PSJOS=$P(PSJSYSP0,"^",11),PSGLPF=1 D ^PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON
- +2 DO ENL^PSJO3
- if "^N"[PSJOL
- QUIT
- SET PSJOS=$PIECE(PSJSYSP0,"^",11)
- DO ^PSJO
- KILL PSGLPF
- if 'PSJON
- QUIT
- SET PSGLMT=PSJON
- +3 FOR
- READ !!,"Select orders for labels: ",X:DTIME
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST
- SET X="^"
- if "^"[X
- QUIT
- Begin DoDot:1
- +4 IF X?2."?"
- DO H2^PSGON
- KILL X
- QUIT
- +5 IF X?1."?"
- WRITE !!?2,"Select the orders for which you want labels printed."
- KILL X
- QUIT
- +6 IF X="A"
- DO AADR^PSJUTL
- KILL X
- QUIT
- +7 IF X'?1."?"
- DO ^PSGON
- if '$DATA(X)
- WRITE $CHAR(7)," ??"
- QUIT
- End DoDot:1
- if $DATA(X)
- QUIT
- +8 IF "^"[X
- KILL ^TMP("PSJON",$JOB)
- QUIT
- +9 DO DEV
- IF POP!$DATA(IO("Q"))
- KILL ^TMP("PSJON",$JOB)
- QUIT
- +10 ;
- ENPLP ;
- +1 DO NOW^%DTC
- SET PSGDT=+$EXTRACT(%,1,12)
- SET (DFN,PSGOP)=PSGP
- if $DATA(ZTSK)
- DO ^PSJAC
- DO ENPVSET^PSGLPI
- USE IO
- +2 NEW PSJFIRST
- SET PSJFIRST=1
- FOR PSGPL1=1:1:PSGODDD
- FOR PSGPL2=1:1
- SET PSGPL3=$PIECE(PSGODDD(PSGPL1),",",PSGPL2)
- if 'PSGPL3
- QUIT
- SET (PSGORD,PSJORD)=^TMP("PSJON",$JOB,PSGPL3)
- Begin DoDot:1
- +3 IF PSJFIRST
- IF $PIECE(PSJSYSW0,U,18)
- DO ENHEDER^PSGLPI
- SET PSJFIRST=0
- +4 IF PSGORD["V"
- DO EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)
- DO KL
- QUIT
- +5 IF PSGORD'["P"
- DO ^PSGLOI
- DO KL
- QUIT
- +6 SET X=$PIECE($GET(^PS(53.1,+PSGORD,0)),"^",4)
- IF X="F"
- DO EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)
- DO KL
- QUIT
- +7 DO ^PSGLOI
- DO KL
- End DoDot:1
- +8 QUIT
- +9 ;
- DT ;
- +1 FOR
- KILL %DT
- SET %DT="ET"
- SET %DT(0)="-NOW"
- READ !!,"Enter label start date: ",X:DTIME
- if X?1."?"
- DO DTM^PSGLH
- DO ^%DT
- KILL %DT
- IF Y>0!("^"[X)
- SET PSGLBLD=Y
- SET ZTSAVE("PSGLBLD")=""
- QUIT
- +2 if Y'>0
- WRITE $CHAR(7),!?3,"(No date selected for label print.)"
- QUIT
- +3 ;
- KL ; kill other label records for the same order
- +1 SET QS=$SELECT(PSGORD["V":3,PSGORD["N":2,1:1)
- KILL ^PS(53.41,2,1,DUZ,1,PSGOP,1,QS,+PSGORD)
- +2 QUIT