- ACHSCHLG ; IHS/ITSC/PMF - COMPRESS PRINTING OF HOSPITAL LOG ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- W *7,!!?20,"This report may take awhile to compile."
- W !?9,"It is recommended that you QUEUE your output to a PRINTER."
- DEVICE ;Device Selection
- W *7,*7,!!,"This report requires 132 column format."
- K DIR
- S %ZIS="PQ"
- W !
- D ^%ZIS
- I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED!" G END
- K ACHS("PRINT")
- I '$D(^%ZIS(2,IOST(0),12.1))!'$D(^%ZIS(2,IOST(0),5)) G NOCON
- I $G(^%ZIS(2,IOST(0),12.1))=""!($P($G(^%ZIS(2,IOST(0),5)),U)="") G NOCON
- S ACHS("PRINT",16)=$G(^%ZIS(2,IOST(0),12.1)),ACHS("PRINT",10)=$P($G(^%ZIS(2,IOST(0),5)),U)
- W !
- K DIR
- S DIR(0)="Y",DIR("A")="Should Output be in CONDENSED PRINT",DIR("B")="YES"
- D ^DIR
- K DIR
- Q:Y["^"
- I '$G(Y),IOM'=132 D G END:Y=0,DEVICE:Y=1
- . I $D(ACHS("PRINT",10)) W @ACHS("PRINT",10)
- . W !!!,"You have elected NOT to print in compressed print mode",!,"and the selected printer does not have 132 column capability."
- . K DIR
- . S DIR("A")="Select another printer",DIR(0)="Y",DIR("B")="NO"
- . D ^DIR
- . K DIR
- .Q
- I '$G(Y),IOM=132 W !!,"Please make sure the printer is loaded with 132 column paper."
- S:IOM=80 IOM=132
- S:$D(IO("Q")) IOP="Q;"_ION
- S:'$D(IO("Q")) IOP=ION
- W !!!!
- N L,DIC,FLDS,BY,DIOBEG,DIOEND
- S L=0,DIC="^ACHSF(",FLDS="[ACHSRPTHOSPLOGP]",BY="[ACHSRPTHOSPLOGS]"
- ; S DIOBEG="W @ACHS(""PRINT"",16)",DIOEND="W @ACHS(""PRINT"",10)"
- D EN1^DIP
- END ;
- Q
- ;
- NOCON ;
- W *7,!!,"===Condensed Print Mode has not been established for this Device.===",!!!!
- I $$DIR^XBDIR("E","Press <RETURN> to Continue")
- G END
- ;
- ACHSCHLG ; IHS/ITSC/PMF - COMPRESS PRINTING OF HOSPITAL LOG ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 WRITE *7,!!?20,"This report may take awhile to compile."
- +4 WRITE !?9,"It is recommended that you QUEUE your output to a PRINTER."
- DEVICE ;Device Selection
- +1 WRITE *7,*7,!!,"This report requires 132 column format."
- +2 KILL DIR
- +3 SET %ZIS="PQ"
- +4 WRITE !
- +5 DO ^%ZIS
- +6 IF POP
- WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED!"
- GOTO END
- +7 KILL ACHS("PRINT")
- +8 IF '$DATA(^%ZIS(2,IOST(0),12.1))!'$DATA(^%ZIS(2,IOST(0),5))
- GOTO NOCON
- +9 IF $GET(^%ZIS(2,IOST(0),12.1))=""!($PIECE($GET(^%ZIS(2,IOST(0),5)),U)="")
- GOTO NOCON
- +10 SET ACHS("PRINT",16)=$GET(^%ZIS(2,IOST(0),12.1))
- SET ACHS("PRINT",10)=$PIECE($GET(^%ZIS(2,IOST(0),5)),U)
- +11 WRITE !
- +12 KILL DIR
- +13 SET DIR(0)="Y"
- SET DIR("A")="Should Output be in CONDENSED PRINT"
- SET DIR("B")="YES"
- +14 DO ^DIR
- +15 KILL DIR
- +16 IF Y["^"
- QUIT
- +17 IF '$GET(Y)
- IF IOM'=132
- Begin DoDot:1
- +18 IF $DATA(ACHS("PRINT",10))
- WRITE @ACHS("PRINT",10)
- +19 WRITE !!!,"You have elected NOT to print in compressed print mode",!,"and the selected printer does not have 132 column capability."
- +20 KILL DIR
- +21 SET DIR("A")="Select another printer"
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- +22 DO ^DIR
- +23 KILL DIR
- +24 QUIT
- End DoDot:1
- IF Y=0
- GOTO END
- IF Y=1
- GOTO DEVICE
- +25 IF '$GET(Y)
- IF IOM=132
- WRITE !!,"Please make sure the printer is loaded with 132 column paper."
- +26 IF IOM=80
- SET IOM=132
- +27 IF $DATA(IO("Q"))
- SET IOP="Q;"_ION
- +28 IF '$DATA(IO("Q"))
- SET IOP=ION
- +29 WRITE !!!!
- +30 NEW L,DIC,FLDS,BY,DIOBEG,DIOEND
- +31 SET L=0
- SET DIC="^ACHSF("
- SET FLDS="[ACHSRPTHOSPLOGP]"
- SET BY="[ACHSRPTHOSPLOGS]"
- +32 ; S DIOBEG="W @ACHS(""PRINT"",16)",DIOEND="W @ACHS(""PRINT"",10)"
- +33 DO EN1^DIP
- END ;
- +1 QUIT
- +2 ;
- NOCON ;
- +1 WRITE *7,!!,"===Condensed Print Mode has not been established for this Device.===",!!!!
- +2 IF $$DIR^XBDIR("E","Press <RETURN> to Continue")
- +3 GOTO END
- +4 ;
