ACHSAD.m

ACHSAD ; IHS/ITSC/PMF - DISPLAY DOCUMENTS ;    [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ;

 S ACHSVIEW=""

 F  D ^ACHSUSC Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN)!$D(ACHSDVEW)

 K ACHSVIEW

 Q

 ;

DUMP ;EP - From Option.

 ;

 ;5/14/01  pmf  init basic vars, if necessary

 I '$D(ACHSCFY)!($G(ACHSFC)="") D ^ACHSVAR

 ;

 K DR,D0,D1,D2,ACHSDIEN

 ;

 D ^ACHSUD              ;SELECT DOCUMENT AND DISPLAY

 I '$D(ACHSDIEN) D K Q

 ;

DEV ;

 S %=$$PB^ACHS

 I %="^"!$D(DUOUT)!$D(DTOUT) D K Q

 I %="B" D DIQ^XBLM("^ACHSF("_DUZ(2)_",""D"",",ACHSDIEN),HOME^%ZIS Q

 S %ZIS="OPQ"

 D ^%ZIS

 I POP D HOME^%ZIS D K Q

 G:'$D(IO("Q")) START

 K IO("Q")

 I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 S ZTRTN="START^ACHSAD",ZTDESC="DUMP OF DATA FROM DOCUMENT "_$$DOC^ACHS(0,14)_"-"_ACHSFC_"-"_$$DOC^ACHS(0,1)

 F ACHS="AC*","ACHS*" S ZTSAVE(ACHS)=""

 D ^%ZTLOAD

 G DEV:'$D(ZTSK)

 K ZTSK

 D K

 Q

 ;

START ;EP - TaskMan.

 S:$D(IO("S")) IOSL=66

 U IO

 S DIC="^ACHSF("_DUZ(2)_",""D"",",DA=ACHSDIEN

 D EN^DIQ

 I IO'=$G(ACHSIO) W @IOF

K ;

 K ACHSDIEN,D0,D1

 D ^%ZISC

 D ERPT^ACHS:$D(ZTQUEUED)

 I IO(0)=IO D RTRN^ACHS

 Q

 ;

ACHSAD    ; IHS/ITSC/PMF - DISPLAY DOCUMENTS ;    [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ;

 +4        SET ACHSVIEW=""

 +5        FOR 

               DO ^ACHSUSC

               IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)!$DATA(ACHSDVEW)

                   QUIT 

 +6        KILL ACHSVIEW

 +7        QUIT 

 +8       ;

DUMP      ;EP - From Option.

 +1       ;

 +2       ;5/14/01  pmf  init basic vars, if necessary

 +3        IF '$DATA(ACHSCFY)!($GET(ACHSFC)="")

               DO ^ACHSVAR

 +4       ;

 +5        KILL DR,D0,D1,D2,ACHSDIEN

 +6       ;

 +7       ;SELECT DOCUMENT AND DISPLAY

           DO ^ACHSUD

 +8        IF '$DATA(ACHSDIEN)

               DO K

               QUIT 

 +9       ;

DEV       ;

 +1        SET %=$$PB^ACHS

 +2        IF %="^"!$DATA(DUOUT)!$DATA(DTOUT)

               DO K

               QUIT 

 +3        IF %="B"

               DO DIQ^XBLM("^ACHSF("_DUZ(2)_",""D"",",ACHSDIEN)

               DO HOME^%ZIS

               QUIT 

 +4        SET %ZIS="OPQ"

 +5        DO ^%ZIS

 +6        IF POP

               DO HOME^%ZIS

               DO K

               QUIT 

 +7        IF '$DATA(IO("Q"))

               GOTO START

 +8        KILL IO("Q")

 +9        IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +10       SET ZTRTN="START^ACHSAD"

           SET ZTDESC="DUMP OF DATA FROM DOCUMENT "_$$DOC^ACHS(0,14)_"-"_ACHSFC_"-"_$$DOC^ACHS(0,1)

 +11       FOR ACHS="AC*","ACHS*"

               SET ZTSAVE(ACHS)=""

 +12       DO ^%ZTLOAD

 +13       IF '$DATA(ZTSK)

               GOTO DEV

 +14       KILL ZTSK

 +15       DO K

 +16       QUIT 

 +17      ;

START     ;EP - TaskMan.

 +1        IF $DATA(IO("S"))

               SET IOSL=66

 +2        USE IO

 +3        SET DIC="^ACHSF("_DUZ(2)_",""D"","

           SET DA=ACHSDIEN

 +4        DO EN^DIQ

 +5        IF IO'=$GET(ACHSIO)

               WRITE @IOF

K         ;

 +1        KILL ACHSDIEN,D0,D1

 +2        DO ^%ZISC

 +3        IF $DATA(ZTQUEUED)

               DO ERPT^ACHS

 +4        IF IO(0)=IO

               DO RTRN^ACHS

 +5        QUIT 

 +6       ;