- PSIVALNC ;BIR/JLC - TEST CONTROL CODES ;16 DEC 97 / 1:39 PM
- ;;5.0; INPATIENT MEDICATIONS ;**58,178**;16 DEC 97;Build 9
- ;
- ; Reference to ^%ZIS(2 is supported by DBIA 3435.
- ;
- W !!?2,"(Please make any initial adjustments before selecting the label device.)",!
- K %ZIS,IO("Q"),IOP S %ZIS="Q",PSIVION=ION,%ZIS("A")="Print labels on DEVICE: ",%ZIS("B")=PSIVPL D ^%ZIS I POP S IOP=PSIVION D ^%ZIS W !?2,"No device selected." K PSIVION,IOP,%ZIS Q
- N X0,PSJIO,I
- S I=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=^(I,0),PSJIO($P(X0,"^"))=^(1)
- S PSJIO=$S('$D(PSJIO):0,1:1)
- D PSET^%ZISP
- S $P(L1,"_",10)="" F D PRNT,ASK Q:%'=2
- ;
- D ^%ZISC K %ZIS,IO("Q"),IOP,L1,L2,PSIVION,X,%Y,POP,D,Y,Z,I,ZISI,Y Q
- ;
- PRNT ;
- G:'$D(IO("Q")) ENQ K ZTSK,ZTSAVE S ZTRTN="ENQ^PSIVALNC",ZTDESC="IV LABEL ALIGNMENT",ZTIO=ION,ZTDTH=$H F G="L1","L2","PSIVSITE","PSJSYSW0","PSJSYSU","PSJIO" S ZTSAVE(G)=""
- D ^%ZTLOAD Q
- ;
- ENQ ;
- U IO
- I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
- D LP
- I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- P F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
- W X
- F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
- I 'PSJIO W !
- Q
- ;
- PMR F I="SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
- W X
- F I="EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
- I 'PSJIO W !
- Q
- LP ;
- I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
- S LINE=1
- I 'PSJIO D
- . I IOBARON]"" W @IOBARON
- . W "nnnVnnn"
- . I IOBAROFF]"" W @IOBAROFF
- . W !
- I PSJIO D
- . F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
- . W "nnnVnnn"
- . F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
- S X=L1 D P D PMR
- I 'PSJIO D Q
- . W !
- I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
- Q
- ;
- ASK ;
- U IO(0) F W !!,"Is the label alignment correct" S %=1 D YN^DICN Q:% S HELP="ALGN" D ^PSIVHLP
- I %=2 R !!,"Please make any adjustments necessary, and then press RETURN. ",X:DTIME W:'$T $C(7) I X="^"!'$T S %=-1
- Q
- PGM ;;
- D ^PSIVXU Q:$D(XQUIT) D ^PSIVALNC,ENIVKV^PSGSETU K I,Z,ZISI
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVALNC 1994 printed Jan 18, 2025@03:05:04 Page 2
- PSIVALNC ;BIR/JLC - TEST CONTROL CODES ;16 DEC 97 / 1:39 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**58,178**;16 DEC 97;Build 9
- +2 ;
- +3 ; Reference to ^%ZIS(2 is supported by DBIA 3435.
- +4 ;
- +5 WRITE !!?2,"(Please make any initial adjustments before selecting the label device.)",!
- +6 KILL %ZIS,IO("Q"),IOP
- SET %ZIS="Q"
- SET PSIVION=ION
- SET %ZIS("A")="Print labels on DEVICE: "
- SET %ZIS("B")=PSIVPL
- DO ^%ZIS
- IF POP
- SET IOP=PSIVION
- DO ^%ZIS
- WRITE !?2,"No device selected."
- KILL PSIVION,IOP,%ZIS
- QUIT
- +7 NEW X0,PSJIO,I
- +8 SET I=0
- FOR
- SET I=$ORDER(^%ZIS(2,IOST(0),55,I))
- if 'I
- QUIT
- SET X0=^(I,0)
- SET PSJIO($PIECE(X0,"^"))=^(1)
- +9 SET PSJIO=$SELECT('$DATA(PSJIO):0,1:1)
- +10 DO PSET^%ZISP
- +11 SET $PIECE(L1,"_",10)=""
- FOR
- DO PRNT
- DO ASK
- if %'=2
- QUIT
- +12 ;
- +13 DO ^%ZISC
- KILL %ZIS,IO("Q"),IOP,L1,L2,PSIVION,X,%Y,POP,D,Y,Z,I,ZISI,Y
- QUIT
- +14 ;
- PRNT ;
- +1 if '$DATA(IO("Q"))
- GOTO ENQ
- KILL ZTSK,ZTSAVE
- SET ZTRTN="ENQ^PSIVALNC"
- SET ZTDESC="IV LABEL ALIGNMENT"
- SET ZTIO=ION
- SET ZTDTH=$HOROLOG
- FOR G="L1","L2","PSIVSITE","PSJSYSW0","PSJSYSU","PSJIO"
- SET ZTSAVE(G)=""
- +2 DO ^%ZTLOAD
- QUIT
- +3 ;
- ENQ ;
- +1 USE IO
- +2 IF PSJIO
- IF $GET(PSJIO("FI"))]""
- XECUTE PSJIO("FI")
- +3 DO LP
- +4 IF PSJIO
- IF $GET(PSJIO("FE"))]""
- XECUTE PSJIO("FE")
- +5 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 QUIT
- +7 ;
- P FOR I="ST","STF","SM","SMF"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- +1 WRITE X
- +2 FOR I="ETF","ET","EMF","EM"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- +3 IF 'PSJIO
- WRITE !
- +4 QUIT
- +5 ;
- PMR FOR I="SM","SMF"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- +1 WRITE X
- +2 FOR I="EMF","EM"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- +3 IF 'PSJIO
- WRITE !
- +4 QUIT
- LP ;
- +1 IF PSJIO
- IF $GET(PSJIO("SL"))]""
- XECUTE PSJIO("SL")
- +2 SET LINE=1
- +3 IF 'PSJIO
- Begin DoDot:1
- +4 IF IOBARON]""
- WRITE @IOBARON
- +5 WRITE "nnnVnnn"
- +6 IF IOBAROFF]""
- WRITE @IOBAROFF
- +7 WRITE !
- End DoDot:1
- +8 IF PSJIO
- Begin DoDot:1
- +9 FOR I="SB","SBF"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- +10 WRITE "nnnVnnn"
- +11 FOR I="EBF","EB"
- IF $GET(PSJIO(I))]""
- XECUTE PSJIO(I)
- End DoDot:1
- +12 SET X=L1
- DO P
- DO PMR
- +13 IF 'PSJIO
- Begin DoDot:1
- +14 WRITE !
- End DoDot:1
- QUIT
- +15 IF PSJIO
- IF $GET(PSJIO("EL"))]""
- XECUTE PSJIO("EL")
- +16 QUIT
- +17 ;
- ASK ;
- +1 USE IO(0)
- FOR
- WRITE !!,"Is the label alignment correct"
- SET %=1
- DO YN^DICN
- if %
- QUIT
- SET HELP="ALGN"
- DO ^PSIVHLP
- +2 IF %=2
- READ !!,"Please make any adjustments necessary, and then press RETURN. ",X:DTIME
- if '$TEST
- WRITE $CHAR(7)
- IF X="^"!'$TEST
- SET %=-1
- +3 QUIT
- PGM ;;
- +1 DO ^PSIVXU
- if $DATA(XQUIT)
- QUIT
- DO ^PSIVALNC
- DO ENIVKV^PSGSETU
- KILL I,Z,ZISI
- +2 QUIT