ACHSCHLG.m

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       ;