AMER5 ; IHS/ANMC/GIS - PRINT PATIENT ED MATERIALS ;
;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
;
EN1 ; EP
S DIR(0)="SO^A:ADULT;P:PEDIATRIC",DIR("A")="Print instructions for which age group" D ^DIR K DIR
I '$D(DIRUT),'$D(DTOUT),'$D(DUOUT),$D(Y),$E(Y)'=U S AMERAGE=Y
;IHS/OIT/SCR 2/9/09 - AVOID UNDEFINED ERROR IF USER "^" PAST THIS PROMPT
Q:$G(AMERAGE)=""
K AMEROUT
TOPIC S DIC("A")="Enter "_$S($O(^TMP("AMER",$J,2,20,0)):"another ",1:"")_"patient education topic: "
S DIC="^AMER(4,",DIC(0)="AEQ",DIC("S")="I $P(^(0),U,3)="""_AMERAGE_""",$P(^(0),U)'[""FOLLOW"""
D ^DIC K DIC S AMERAGE=+Y
ZIS ;
; CHOOSE THE NUMBER OF COPIES AND DEVICE
S DIR(0)="N^1:10:0",DIR("A")="Enter the number of copies you would like to print"
S DIR("B")=1
D ^DIR K DIR S AMERNUM=Y
S %ZIS="Q",%ZIS("A")="Print patient instructions on which device: "
W *7,!!,"If you choose to send the output to your slave printer, print 1 copy at a time.",!
D ^%ZIS Q:POP
; IF USER CHOOSES TO QUEUE THE OUTPUT
I $D(IO("Q")) D
.S ZTRTN="PRINT^AMER5"
.S ZTIO=ION
.S ZTDESC="Print patient instructions for ER system"
.S ZTSAVE("*")=""
.D ^%ZTLOAD I 1
I W !!,$S($D(ZTSK):"Request queued!",1:"Unable to queue job. Request cancelled!") D ^%ZISC D EXIT Q
D PRINT
D EXIT
K DIRUT,DTOUT,DUOUT,AMEREN1
D ^%ZISC
Q
PRINT ; EP
U IO
F AMERI=1:1:AMERNUM D
.S NODE=0
.S RECORD=0
.F S NODE=$O(^AMER(4,AMERAGE,NODE)) Q:'NODE!$D(AMEROUT) D
..F S RECORD=$O(^AMER(4,AMERAGE,NODE,RECORD)) Q:'RECORD!$D(AMEROUT) D
...W !,$P(^AMER(4,AMERAGE,NODE,RECORD,0),U)
...I $E(IOST,1,2)="C-",IOSL-4<$Y D PAUSE W @IOF
.I $E(IOST,1,2)'="C-" W @IOF
.I $E(IOST,1,2)="C-" D PAUSE W @IOF
Q
PAUSE ; EP
K DIR,AMEROUT
W !
S DIR(0)="EOA"
S DIR("A")="Press RETURN to continue or '^' to exit. "
K DTOUT,DUOUT,AMEROUT
D ^DIR
S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) AMEROUT=""
S:X="^^"!$D(DTOUT) AMEROUT=""
S:$G(X)["^" AMEROUT=""
K DIR,DIRUT,DIROUT,DUOUT,DTOUT
Q
EXIT ; EP
K X,AMER,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,AMERI,AMERNUM,NODE,RECORD
K AMERAGE,AMEROPT,DIJ,DISYS,DIWF,DIWTC,DIWX,DP,P,W,DIWI
Q
AMER5 ; IHS/ANMC/GIS - PRINT PATIENT ED MATERIALS ;
+1 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
+2 ;
EN1 ; EP
+1 SET DIR(0)="SO^A:ADULT;P:PEDIATRIC"
SET DIR("A")="Print instructions for which age group"
DO ^DIR
KILL DIR
+2 IF '$DATA(DIRUT)
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF $DATA(Y)
IF $EXTRACT(Y)'=U
SET AMERAGE=Y
+3 ;IHS/OIT/SCR 2/9/09 - AVOID UNDEFINED ERROR IF USER "^" PAST THIS PROMPT
+4 IF $GET(AMERAGE)=""
QUIT
+5 KILL AMEROUT
TOPIC SET DIC("A")="Enter "_$SELECT($ORDER(^TMP("AMER",$JOB,2,20,0)):"another ",1:"")_"patient education topic: "
+1 SET DIC="^AMER(4,"
SET DIC(0)="AEQ"
SET DIC("S")="I $P(^(0),U,3)="""_AMERAGE_""",$P(^(0),U)'[""FOLLOW"""
+2 DO ^DIC
KILL DIC
SET AMERAGE=+Y
ZIS ;
+1 ; CHOOSE THE NUMBER OF COPIES AND DEVICE
+2 SET DIR(0)="N^1:10:0"
SET DIR("A")="Enter the number of copies you would like to print"
+3 SET DIR("B")=1
+4 DO ^DIR
KILL DIR
SET AMERNUM=Y
+5 SET %ZIS="Q"
SET %ZIS("A")="Print patient instructions on which device: "
+6 WRITE *7,!!,"If you choose to send the output to your slave printer, print 1 copy at a time.",!
+7 DO ^%ZIS
IF POP
QUIT
+8 ; IF USER CHOOSES TO QUEUE THE OUTPUT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="PRINT^AMER5"
+11 SET ZTIO=ION
+12 SET ZTDESC="Print patient instructions for ER system"
+13 SET ZTSAVE("*")=""
+14 DO ^%ZTLOAD
IF 1
End DoDot:1
+15 IF $TEST
WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Unable to queue job. Request cancelled!")
DO ^%ZISC
DO EXIT
QUIT
+16 DO PRINT
+17 DO EXIT
+18 KILL DIRUT,DTOUT,DUOUT,AMEREN1
+19 DO ^%ZISC
+20 QUIT
PRINT ; EP
+1 USE IO
+2 FOR AMERI=1:1:AMERNUM
Begin DoDot:1
+3 SET NODE=0
+4 SET RECORD=0
+5 FOR
SET NODE=$ORDER(^AMER(4,AMERAGE,NODE))
IF 'NODE!$DATA(AMEROUT)
QUIT
Begin DoDot:2
+6 FOR
SET RECORD=$ORDER(^AMER(4,AMERAGE,NODE,RECORD))
IF 'RECORD!$DATA(AMEROUT)
QUIT
Begin DoDot:3
+7 WRITE !,$PIECE(^AMER(4,AMERAGE,NODE,RECORD,0),U)
+8 IF $EXTRACT(IOST,1,2)="C-"
IF IOSL-4<$Y
DO PAUSE
WRITE @IOF
End DoDot:3
End DoDot:2
+9 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+10 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
WRITE @IOF
End DoDot:1
+11 QUIT
PAUSE ; EP
+1 KILL DIR,AMEROUT
+2 WRITE !
+3 SET DIR(0)="EOA"
+4 SET DIR("A")="Press RETURN to continue or '^' to exit. "
+5 KILL DTOUT,DUOUT,AMEROUT
+6 DO ^DIR
+7 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET AMEROUT=""
+8 IF X="^^"!$DATA(DTOUT)
SET AMEROUT=""
+9 IF $GET(X)["^"
SET AMEROUT=""
+10 KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
+11 QUIT
EXIT ; EP
+1 KILL X,AMER,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,AMERI,AMERNUM,NODE,RECORD
+2 KILL AMERAGE,AMEROPT,DIJ,DISYS,DIWF,DIWTC,DIWX,DP,P,W,DIWI
+3 QUIT
