- 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
