- 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 ;
