- PSOLLL7 ;BHAM/JLC - LASER LABEL MULTI RX REFILL REQUEST FORM ;08/23/17 20:04
- ;;7.0;OUTPATIENT PHARMACY;**120,161,200,326,441**;DEC 1997;Build 208
- ;
- ;Reference to ^PS(59.7 supported by DBIA 694
- ;Reference to ^PS(55 supported by DBIA 2228
- ;Read-only reference to %ZIS(2 supported by DBIA 3435
- ;
- EN D MAIL
- I $G(PSOIO("PII"))]"" X PSOIO("PII")
- S T="Use the adhesive label above to mail prescription" D PRINT(T)
- S T="documents to your pharmacy." D PRINT(T)
- REFILL Q:'DFN S PS1=$G(^PS(59,PSOSITE,1)),PSOSITE7=$G(^("IB")),PSOSYS=$G(^PS(59.7,1,40.1))
- I '$D(PSSPND) F PSRX=0:0 S PSRX=$O(RX(PSRX)) Q:'PSRX K RX(PSRX)
- S BLNKLIN="",$P(BLNKLIN,"_",45)="_"
- F PSRX=0:0 S PSRX=$O(^PS(55,DFN,"P",PSRX)) Q:'PSRX D RZX
- ;NEW LABEL
- S PSOX=0
- DOCNEW I $G(PSOIO("RPI"))]"" X PSOIO("RPI")
- S PSOYI=PSOTYI,PSOX=PSOLX,ORIGY=PSOY
- D HDR S PSA=0
- F J=1:1 S PSA=$O(RX(PSA)) Q:'PSA D SCRPTNEW
- I $O(RX(0))="" G EXIT
- I PSOY=ORIGY G EXIT
- S PSOYI=PSOSYI,T=BLNKLIN D PRINT(T) S PSOYI=PSOTYI
- S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- S T="Patient's Signature & Date "_$P(PS,"^",6)_" "_PSONOW D PRINT(T)
- EXIT K PSINF,AMC,PSA,PSDFN,PSDO,PSDT2,PSRFL,PSRX,PSLN,PSRXX,PSSS,PSST,PSOCR,DIWL,DIWR,DIWF,PSO9
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- SCRPTNEW S T="____"_$$ZZ^PSOSUTL(PSA) K ZDRUG D PRINT(T) S PSOYI=PSOTYI
- D DTCONNW
- S PSOYI=PSOTYI,OPSOX=PSOX,PSOX=PSOX+PSOXI,T="Refills "_$P(RX(PSA),"^",2)_" Exp "_PSDT2_" Rx# "_$P(^PSRX(PSA,0),"^") K TN D PRINT(T)
- S PSOYI=PSOBYI
- I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
- S X2=PSOINST_"-"_PSA,PSOX=PSOX+PSOXI
- W X2
- I $G(PSOIO("EBT"))]"" X PSOIO("EBT")
- S PSOX=OPSOX
- I PSOY>PSOYM D D:$O(RX(PSA)) HDR Q
- .S T=BLNKLIN,PSOYI=PSOSYI D PRINT(T) S PSOYI=PSOTYI
- .S T="Patient's Signature & Date "_$P(PS,"^",6)_" "_PSONOW D PRINT(T)
- .S PSOY=ORIGY,PSOYI=PSOTYI
- .I PSOX=PSORX S PSOX=PSOLX W @IOF Q
- .S PSOX=PSORX
- Q
- DTCONNW S PSDT2=$P(RX(PSA),"^"),PSDT2=$E(PSDT2,4,5)_"/"_$E(PSDT2,6,7)_"/"_($E(PSDT2,1,3)+1700) Q
- RFILL2 F AMC=0:0 S AMC=$O(^PSRX(PSRXX,1,AMC)) Q:'AMC S PSRFL=PSRFL-1
- I PSRFL>0 S X1=DT,X2=$P(^PSRX(PSRXX,0),"^",8)-10 D C^%DTC I X'<$P(^(2),"^",6) S PSRFL=0
- Q
- RZX ;
- S PSOORIG=0 ;441 PAPI
- S PSRXX=+^PS(55,DFN,"P",PSRX,0) I $D(^PSRX(PSRXX,0)) D
- .N EXPDT
- .S EXPDT=$P(^PSRX(PSRXX,2),"^",6) I EXPDT'>DT Q
- .S PSRFL=$P(^PSRX(PSRXX,0),"^",9) D:$D(^PSRX(PSRXX,1))&PSRFL RFILL2
- .I +PSRFL=0,$G(^PSRX(PSRXX,"PARK")),$P($G(^PSRX(PSRXX,"STA")),"^")=0 D CHKLBL^PSOPRKA(PSRXX,0) I 'LBLP S RX(PSRXX)=EXPDT_"^"_PSRFL,PSOORIG=1
- .I PSRFL>0,$P($G(^PSRX(PSRXX,"STA")),"^")<10,134'[$E(+$P($G(^("STA")),"^")) S RX(PSRXX)=EXPDT_"^"_PSRFL
- Q
- HDR S T=PNM D PRINT(T)
- D ADD^VADPT
- I $G(VAPA(1))="" G HDR5
- F I=1:1:3 I $G(VAPA(I))]"" S T=VAPA(I) D PRINT(T)
- S A=+$G(VAPA(5)) I A S A=$S($D(^DIC(5,A,0)):$P(^(0),"^",2),1:"UNKNOWN")
- S B=$G(VAPA(4))_", "_A_" "_$S($G(VAPA(11)):$P(VAPA(11),"^",2),1:$G(VAPA(6)))
- S T=B D PRINT(T)
- HDR5 I $O(RX(0))="" D S PSOY=PSOY+PSOYI Q
- .S PSOY=PSOY+PSOYI,T="You have no refillable prescriptions as of "_PSONOW_"." D PRINT(T)
- .S T="Please contact your provider if you need new prescriptions." D PRINT(T)
- .I '$D(PSOINST) D SITE
- .S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- .S OPSOX=PSOX,OPSOY=PSOY,T=$P(PS,"^",6) S PSOX=2300,PSOY=3900 D PRINT(T) S PSOX=OPSOX,PSOY=OPSOY
- ADD S PSOY=PSOY+PSOYI
- I 'PSOORIG S T="Please check prescriptions to be refilled, sign the form, then" D PRINT(T) ;441 PAPI
- I PSOORIG S T="Please check prescriptions to be filled/refilled, sign the form, then" D PRINT(T)
- S T="mail or return to your pharmacy." D PRINT(T) S PSOY=PSOY+PSOYI
- Q
- MAIL ;PRINT MAILING ADHESIVE LABEL
- S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
- S VAADDR1=$P(PS,"^"),VASTREET=$P(PS,"^",2),STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UNKNOWN")
- S PSZIP=$P(PS,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
- I $G(PSOIO("MLI"))]"" X PSOIO("MLI")
- I $G(PSOIO("PSOFONT"))]"" X PSOIO("PSOFONT")
- S TEXT="Attn: (119)" D PRINT(TEXT)
- S TEXT=VAADDR1 D PRINT(TEXT)
- S TEXT=$G(VASTREET) D PRINT(TEXT)
- S TEXT=$P(PS,"^",7)_", "_$G(STATE)_" "_$G(PSOHZIP) D PRINT(TEXT)
- Q
- PRINT(T) ;
- I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- I $G(PSOIO("ST"))]"" X PSOIO("ST")
- W T,!
- I $G(PSOIO("ET"))]"" X PSOIO("ET")
- Q
- QUEUE ; ENTRY POINT TO PRINT STAND-ALONE MULTI-RX FORM
- S SAVDFN=$D(DFN) ; DFN SET IF COMING FROM HIDDEN ACTION
- I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) Q
- I '$G(PSOSYS) S PSOSYS=$G(^PS(59.7,1,40.1))
- I '$D(PSOINST) D SITE
- W !
- I $D(DFN) G GETPT2
- GETPT S DIC("A")="Enter patient to reprint Multi-Rx refill form for: ",DIC(0)="QEAM" D EN^PSOPATLK S Y=PSOPTLK I Y<0!("^"[X) K PSOPTLK,DIC Q
- S DFN=$P(Y,"^")
- GETPT2 D DEM^VADPT S PNM=VADM(1)
- I $P(VADM(6),"^",2)]"" D G GETPT
- .W $C(7),!!,PNM_" Died "_$P(VADM(6),"^",2)_".",!
- Q1 W ! K POP,ZTSK S %ZIS("B")="",%ZIS="MNQ",%ZIS("A")="Select LABEL DEVICE: " D ^%ZIS S PSLION=ION K %ZIS("A")
- I $G(POP) Q
- I $G(IOST(0)),'$D(^%ZIS(2,IOST(0),55,"B","LL")) W !,"Must specify a laser labels printer for Multi-Rx form." G Q1
- I '$G(IOST(0)) W !,"Nothing queued to print." H 1 Q
- D 6^VADPT,PID^VADPT6 S SSNP=""
- D NOW^%DTC S Y=$P(%,"."),PSOFNOW=% X ^DD("DD") S PSONOW=Y
- F G="DFN","PNM","PSOPAR","PSOSITE","SSNP","PSONOW","PSOSYS","PSOINST" S:$D(@G) ZTSAVE(G)=""
- S ZTRTN="DQ^PSOLLL7",ZTIO=PSLION,ZTDESC="Outpatient Pharmacy Multi-Rx print",ZTDTH=$H,PDUZ=DUZ
- D ^%ZISC,^%ZTLOAD W:$D(ZTSK) !!,"Multi-Rx form queued to print",!! H 1 K G
- I $G(SAVDFN)=0 K DFN,SAVDFN
- Q
- DQ N PSOBIO S (I,PSOIO)=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSOIO($P(X0,"^"))=^(1),PSOIO=1
- I $G(PSOIO("LLI"))]"" X PSOIO("LLI")
- G EN
- SITE ;
- K ^UTILITY("DIQ1",$J) S DA=$P($$SITE^VASITE(),"^")
- I $G(DA)>0 S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIC
- I '$D(PSOINST) S PSOINST=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLL7 6022 printed Feb 18, 2025@23:57:03 Page 2
- PSOLLL7 ;BHAM/JLC - LASER LABEL MULTI RX REFILL REQUEST FORM ;08/23/17 20:04
- +1 ;;7.0;OUTPATIENT PHARMACY;**120,161,200,326,441**;DEC 1997;Build 208
- +2 ;
- +3 ;Reference to ^PS(59.7 supported by DBIA 694
- +4 ;Reference to ^PS(55 supported by DBIA 2228
- +5 ;Read-only reference to %ZIS(2 supported by DBIA 3435
- +6 ;
- EN DO MAIL
- +1 IF $GET(PSOIO("PII"))]""
- XECUTE PSOIO("PII")
- +2 SET T="Use the adhesive label above to mail prescription"
- DO PRINT(T)
- +3 SET T="documents to your pharmacy."
- DO PRINT(T)
- REFILL if 'DFN
- QUIT
- SET PS1=$GET(^PS(59,PSOSITE,1))
- SET PSOSITE7=$GET(^("IB"))
- SET PSOSYS=$GET(^PS(59.7,1,40.1))
- +1 IF '$DATA(PSSPND)
- FOR PSRX=0:0
- SET PSRX=$ORDER(RX(PSRX))
- if 'PSRX
- QUIT
- KILL RX(PSRX)
- +2 SET BLNKLIN=""
- SET $PIECE(BLNKLIN,"_",45)="_"
- +3 FOR PSRX=0:0
- SET PSRX=$ORDER(^PS(55,DFN,"P",PSRX))
- if 'PSRX
- QUIT
- DO RZX
- +4 ;NEW LABEL
- +5 SET PSOX=0
- DOCNEW IF $GET(PSOIO("RPI"))]""
- XECUTE PSOIO("RPI")
- +1 SET PSOYI=PSOTYI
- SET PSOX=PSOLX
- SET ORIGY=PSOY
- +2 DO HDR
- SET PSA=0
- +3 FOR J=1:1
- SET PSA=$ORDER(RX(PSA))
- if 'PSA
- QUIT
- DO SCRPTNEW
- +4 IF $ORDER(RX(0))=""
- GOTO EXIT
- +5 IF PSOY=ORIGY
- GOTO EXIT
- +6 SET PSOYI=PSOSYI
- SET T=BLNKLIN
- DO PRINT(T)
- SET PSOYI=PSOTYI
- +7 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- +8 SET T="Patient's Signature & Date "_$PIECE(PS,"^",6)_" "_PSONOW
- DO PRINT(T)
- EXIT KILL PSINF,AMC,PSA,PSDFN,PSDO,PSDT2,PSRFL,PSRX,PSLN,PSRXX,PSSS,PSST,PSOCR,DIWL,DIWR,DIWF,PSO9
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 QUIT
- SCRPTNEW SET T="____"_$$ZZ^PSOSUTL(PSA)
- KILL ZDRUG
- DO PRINT(T)
- SET PSOYI=PSOTYI
- +1 DO DTCONNW
- +2 SET PSOYI=PSOTYI
- SET OPSOX=PSOX
- SET PSOX=PSOX+PSOXI
- SET T="Refills "_$PIECE(RX(PSA),"^",2)_" Exp "_PSDT2_" Rx# "_$PIECE(^PSRX(PSA,0),"^")
- KILL TN
- DO PRINT(T)
- +3 SET PSOYI=PSOBYI
- +4 IF $GET(PSOIO("SBT"))]""
- XECUTE PSOIO("SBT")
- +5 SET X2=PSOINST_"-"_PSA
- SET PSOX=PSOX+PSOXI
- +6 WRITE X2
- +7 IF $GET(PSOIO("EBT"))]""
- XECUTE PSOIO("EBT")
- +8 SET PSOX=OPSOX
- +9 IF PSOY>PSOYM
- Begin DoDot:1
- +10 SET T=BLNKLIN
- SET PSOYI=PSOSYI
- DO PRINT(T)
- SET PSOYI=PSOTYI
- +11 SET T="Patient's Signature & Date "_$PIECE(PS,"^",6)_" "_PSONOW
- DO PRINT(T)
- +12 SET PSOY=ORIGY
- SET PSOYI=PSOTYI
- +13 IF PSOX=PSORX
- SET PSOX=PSOLX
- WRITE @IOF
- QUIT
- +14 SET PSOX=PSORX
- End DoDot:1
- if $ORDER(RX(PSA))
- DO HDR
- QUIT
- +15 QUIT
- DTCONNW SET PSDT2=$PIECE(RX(PSA),"^")
- SET PSDT2=$EXTRACT(PSDT2,4,5)_"/"_$EXTRACT(PSDT2,6,7)_"/"_($EXTRACT(PSDT2,1,3)+1700)
- QUIT
- RFILL2 FOR AMC=0:0
- SET AMC=$ORDER(^PSRX(PSRXX,1,AMC))
- if 'AMC
- QUIT
- SET PSRFL=PSRFL-1
- +1 IF PSRFL>0
- SET X1=DT
- SET X2=$PIECE(^PSRX(PSRXX,0),"^",8)-10
- DO C^%DTC
- IF X'<$PIECE(^(2),"^",6)
- SET PSRFL=0
- +2 QUIT
- RZX ;
- +1 ;441 PAPI
- SET PSOORIG=0
- +2 SET PSRXX=+^PS(55,DFN,"P",PSRX,0)
- IF $DATA(^PSRX(PSRXX,0))
- Begin DoDot:1
- +3 NEW EXPDT
- +4 SET EXPDT=$PIECE(^PSRX(PSRXX,2),"^",6)
- IF EXPDT'>DT
- QUIT
- +5 SET PSRFL=$PIECE(^PSRX(PSRXX,0),"^",9)
- if $DATA(^PSRX(PSRXX,1))&PSRFL
- DO RFILL2
- +6 IF +PSRFL=0
- IF $GET(^PSRX(PSRXX,"PARK"))
- IF $PIECE($GET(^PSRX(PSRXX,"STA")),"^")=0
- DO CHKLBL^PSOPRKA(PSRXX,0)
- IF 'LBLP
- SET RX(PSRXX)=EXPDT_"^"_PSRFL
- SET PSOORIG=1
- +7 IF PSRFL>0
- IF $PIECE($GET(^PSRX(PSRXX,"STA")),"^")<10
- IF 134'[$EXTRACT(+$PIECE($GET(^("STA")),"^"))
- SET RX(PSRXX)=EXPDT_"^"_PSRFL
- End DoDot:1
- +8 QUIT
- HDR SET T=PNM
- DO PRINT(T)
- +1 DO ADD^VADPT
- +2 IF $GET(VAPA(1))=""
- GOTO HDR5
- +3 FOR I=1:1:3
- IF $GET(VAPA(I))]""
- SET T=VAPA(I)
- DO PRINT(T)
- +4 SET A=+$GET(VAPA(5))
- IF A
- SET A=$SELECT($DATA(^DIC(5,A,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +5 SET B=$GET(VAPA(4))_", "_A_" "_$SELECT($GET(VAPA(11)):$PIECE(VAPA(11),"^",2),1:$GET(VAPA(6)))
- +6 SET T=B
- DO PRINT(T)
- HDR5 IF $ORDER(RX(0))=""
- Begin DoDot:1
- +1 SET PSOY=PSOY+PSOYI
- SET T="You have no refillable prescriptions as of "_PSONOW_"."
- DO PRINT(T)
- +2 SET T="Please contact your provider if you need new prescriptions."
- DO PRINT(T)
- +3 IF '$DATA(PSOINST)
- DO SITE
- +4 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- +5 SET OPSOX=PSOX
- SET OPSOY=PSOY
- SET T=$PIECE(PS,"^",6)
- SET PSOX=2300
- SET PSOY=3900
- DO PRINT(T)
- SET PSOX=OPSOX
- SET PSOY=OPSOY
- End DoDot:1
- SET PSOY=PSOY+PSOYI
- QUIT
- ADD SET PSOY=PSOY+PSOYI
- +1 ;441 PAPI
- IF 'PSOORIG
- SET T="Please check prescriptions to be refilled, sign the form, then"
- DO PRINT(T)
- +2 IF PSOORIG
- SET T="Please check prescriptions to be filled/refilled, sign the form, then"
- DO PRINT(T)
- +3 SET T="mail or return to your pharmacy."
- DO PRINT(T)
- SET PSOY=PSOY+PSOYI
- +4 QUIT
- MAIL ;PRINT MAILING ADHESIVE LABEL
- +1 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- +2 IF $PIECE(PSOSYS,"^",4)
- IF $DATA(^PS(59,+$PIECE($GET(PSOSYS),"^",4),0))
- SET PS=^PS(59,$PIECE($GET(PSOSYS),"^",4),0)
- +3 SET VAADDR1=$PIECE(PS,"^")
- SET VASTREET=$PIECE(PS,"^",2)
- SET STATE=$SELECT($DATA(^DIC(5,+$PIECE(PS,"^",8),0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +4 SET PSZIP=$PIECE(PS,"^",5)
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- +5 IF $GET(PSOIO("MLI"))]""
- XECUTE PSOIO("MLI")
- +6 IF $GET(PSOIO("PSOFONT"))]""
- XECUTE PSOIO("PSOFONT")
- +7 SET TEXT="Attn: (119)"
- DO PRINT(TEXT)
- +8 SET TEXT=VAADDR1
- DO PRINT(TEXT)
- +9 SET TEXT=$GET(VASTREET)
- DO PRINT(TEXT)
- +10 SET TEXT=$PIECE(PS,"^",7)_", "_$GET(STATE)_" "_$GET(PSOHZIP)
- DO PRINT(TEXT)
- +11 QUIT
- PRINT(T) ;
- +1 IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +2 IF $GET(PSOIO("ST"))]""
- XECUTE PSOIO("ST")
- +3 WRITE T,!
- +4 IF $GET(PSOIO("ET"))]""
- XECUTE PSOIO("ET")
- +5 QUIT
- QUEUE ; ENTRY POINT TO PRINT STAND-ALONE MULTI-RX FORM
- +1 ; DFN SET IF COMING FROM HIDDEN ACTION
- SET SAVDFN=$DATA(DFN)
- +2 IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- QUIT
- +3 IF '$GET(PSOSYS)
- SET PSOSYS=$GET(^PS(59.7,1,40.1))
- +4 IF '$DATA(PSOINST)
- DO SITE
- +5 WRITE !
- +6 IF $DATA(DFN)
- GOTO GETPT2
- GETPT SET DIC("A")="Enter patient to reprint Multi-Rx refill form for: "
- SET DIC(0)="QEAM"
- DO EN^PSOPATLK
- SET Y=PSOPTLK
- IF Y<0!("^"[X)
- KILL PSOPTLK,DIC
- QUIT
- +1 SET DFN=$PIECE(Y,"^")
- GETPT2 DO DEM^VADPT
- SET PNM=VADM(1)
- +1 IF $PIECE(VADM(6),"^",2)]""
- Begin DoDot:1
- +2 WRITE $CHAR(7),!!,PNM_" Died "_$PIECE(VADM(6),"^",2)_".",!
- End DoDot:1
- GOTO GETPT
- Q1 WRITE !
- KILL POP,ZTSK
- SET %ZIS("B")=""
- SET %ZIS="MNQ"
- SET %ZIS("A")="Select LABEL DEVICE: "
- DO ^%ZIS
- SET PSLION=ION
- KILL %ZIS("A")
- +1 IF $GET(POP)
- QUIT
- +2 IF $GET(IOST(0))
- IF '$DATA(^%ZIS(2,IOST(0),55,"B","LL"))
- WRITE !,"Must specify a laser labels printer for Multi-Rx form."
- GOTO Q1
- +3 IF '$GET(IOST(0))
- WRITE !,"Nothing queued to print."
- HANG 1
- QUIT
- +4 DO 6^VADPT
- DO PID^VADPT6
- SET SSNP=""
- +5 DO NOW^%DTC
- SET Y=$PIECE(%,".")
- SET PSOFNOW=%
- XECUTE ^DD("DD")
- SET PSONOW=Y
- +6 FOR G="DFN","PNM","PSOPAR","PSOSITE","SSNP","PSONOW","PSOSYS","PSOINST"
- if $DATA(@G)
- SET ZTSAVE(G)=""
- +7 SET ZTRTN="DQ^PSOLLL7"
- SET ZTIO=PSLION
- SET ZTDESC="Outpatient Pharmacy Multi-Rx print"
- SET ZTDTH=$HOROLOG
- SET PDUZ=DUZ
- +8 DO ^%ZISC
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !!,"Multi-Rx form queued to print",!!
- HANG 1
- KILL G
- +9 IF $GET(SAVDFN)=0
- KILL DFN,SAVDFN
- +10 QUIT
- DQ NEW PSOBIO
- SET (I,PSOIO)=0
- FOR
- SET I=$ORDER(^%ZIS(2,IOST(0),55,I))
- if 'I
- QUIT
- SET X0=$GET(^(I,0))
- IF X0]""
- SET PSOIO($PIECE(X0,"^"))=^(1)
- SET PSOIO=1
- +1 IF $GET(PSOIO("LLI"))]""
- XECUTE PSOIO("LLI")
- +2 GOTO EN
- SITE ;
- +1 KILL ^UTILITY("DIQ1",$JOB)
- SET DA=$PIECE($$SITE^VASITE(),"^")
- +2 IF $GET(DA)>0
- SET DIC=4
- SET DIQ(0)="I"
- SET DR="99"
- DO EN^DIQ1
- SET PSOINST=$GET(^UTILITY("DIQ1",$JOB,4,DA,99,"I"))
- KILL ^UTILITY("DIQ1",$JOB),DA,DR,DIC
- +3 IF '$DATA(PSOINST)
- SET PSOINST=""
- +4 QUIT