- ACHSOCVQ ; IHS/ITSC/PMF - CHS OBJ CLASS CODE BY VENDOR ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- S ACHSUSR=$$USR^ACHS,ACHSFAC=$$LOC^ACHS
- W !!!!?10,"***** SERVICE CLASS CODE by VENDOR for "_ACHSFAC_" *****"
- FISYR ;Select Fiscal Year
- S ACHSFY=$$FYSEL^ACHS
- G END:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- REPTYP ;Choose Report Type
- K DIR
- S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("B")="Summary",DIR("A")=" Report Type "
- S DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report"
- S DIR("?",2)="which includes TOTALS and PERCENTAGES ONLY."
- S DIR("?",3)="Enter 'D' for a 'DETAILED' report"
- S DIR("?")="which includes PATIENT NAME, HRN, and VENDOR DATA."
- D ^DIR
- G FISYR:$D(DUOUT),END:$D(DTOUT)!$D(DIROUT)
- S ACHSRTYP=Y
- DEVICE ;Select Device
- W *7,!!?20,"This report may take awhile to compile.",!?15,"It is recommended that you QUEUE to a PRINTER.",!
- K DIR
- S %=$$PB^ACHS
- I %=U!$D(DTOUT)!$D(DUOUT) D END Q
- I %="B" D VIEWR^XBLM($S(ACHSRTYP="S":"^ACHSOCV1",1:"^ACHSOCV2")),EN^XBVK("VALM"),END Q
- S %ZIS="PQ"
- D ^%ZIS
- I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" D ^DIR D HOME^%ZIS G END:Y=0,REPTYP:Y=1
- I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHSOCV1:ACHSRTYP="S",^ACHSOCV2:ACHSRTYP="D"
- I $D(IO("S"))!($E(IOST)'="P") G DEVICE
- ZTLOAD ;Loads Taskman
- S ZTRTN=$S(ACHSRTYP="S":"^ACHSOCV1",ACHSRTYP="D":"^ACHSOCV2"),ZTIO="",ZTDESC="OBJ CLASS by VENDOR,"_$S(ACHSRTYP="S":"SUMMARY",1:"DETAIL"),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
- F %="ACHSUSR","ACHSQIO","ACHSFY","ACHSFAC" S ZTSAVE(%)=""
- D ^%ZTLOAD
- K IO("Q")
- D HOME^%ZIS
- K IOP
- END ;
- K DIR,DIC,DIROUT,DTOUT,DUOUT
- D EN^XBVK("ACHS"),^ACHSVAR,HOME^%ZIS
- Q
- ;
- ACHSOCVQ ; IHS/ITSC/PMF - CHS OBJ CLASS CODE BY VENDOR ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 SET ACHSUSR=$$USR^ACHS
- SET ACHSFAC=$$LOC^ACHS
- +4 WRITE !!!!?10,"***** SERVICE CLASS CODE by VENDOR for "_ACHSFAC_" *****"
- FISYR ;Select Fiscal Year
- +1 SET ACHSFY=$$FYSEL^ACHS
- +2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO END
- REPTYP ;Choose Report Type
- +1 KILL DIR
- +2 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
- SET DIR("B")="Summary"
- SET DIR("A")=" Report Type "
- +3 SET DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report"
- +4 SET DIR("?",2)="which includes TOTALS and PERCENTAGES ONLY."
- +5 SET DIR("?",3)="Enter 'D' for a 'DETAILED' report"
- +6 SET DIR("?")="which includes PATIENT NAME, HRN, and VENDOR DATA."
- +7 DO ^DIR
- +8 IF $DATA(DUOUT)
- GOTO FISYR
- IF $DATA(DTOUT)!$DATA(DIROUT)
- GOTO END
- +9 SET ACHSRTYP=Y
- DEVICE ;Select Device
- +1 WRITE *7,!!?20,"This report may take awhile to compile.",!?15,"It is recommended that you QUEUE to a PRINTER.",!
- +2 KILL DIR
- +3 SET %=$$PB^ACHS
- +4 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
- DO END
- QUIT
- +5 IF %="B"
- DO VIEWR^XBLM($SELECT(ACHSRTYP="S":"^ACHSOCV1",1:"^ACHSOCV2"))
- DO EN^XBVK("VALM")
- DO END
- QUIT
- +6 SET %ZIS="PQ"
- +7 DO ^%ZIS
- +8 IF POP
- WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"
- SET DIR(0)="E"
- DO ^DIR
- DO HOME^%ZIS
- IF Y=0
- GOTO END
- IF Y=1
- GOTO REPTYP
- +9 IF '$DATA(IO("Q"))
- IF '$DATA(IO("S"))
- WRITE !
- IF '$DATA(IO("S"))
- DO WAIT^DICD
- IF ACHSRTYP="S"
- GOTO ^ACHSOCV1
- IF ACHSRTYP="D"
- GOTO ^ACHSOCV2
- +10 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
- GOTO DEVICE
- ZTLOAD ;Loads Taskman
- +1 SET ZTRTN=$SELECT(ACHSRTYP="S":"^ACHSOCV1",ACHSRTYP="D":"^ACHSOCV2")
- SET ZTIO=""
- SET ZTDESC="OBJ CLASS by VENDOR,"_$SELECT(ACHSRTYP="S":"SUMMARY",1:"DETAIL")
- SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
- +2 FOR %="ACHSUSR","ACHSQIO","ACHSFY","ACHSFAC"
- SET ZTSAVE(%)=""
- +3 DO ^%ZTLOAD
- +4 KILL IO("Q")
- +5 DO HOME^%ZIS
- +6 KILL IOP
- END ;
- +1 KILL DIR,DIC,DIROUT,DTOUT,DUOUT
- +2 DO EN^XBVK("ACHS")
- DO ^ACHSVAR
- DO HOME^%ZIS
- +3 QUIT
- +4 ;
