- ACHSHLGQ ; IHS/ITSC/PMF - QUEUE CHS HOSPITAL LOG SUMMARY ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- Q ; Under Development
- D ^ACHSVAR Q:'$D(^ACHSF(DUZ(2)))
- K ^TMP($J)
- S ACHSUSR=$$USR^ACHS,ACHSFAC=$$LOC^ACHS
- W !,$$C^XBFUNC("*************************************",80)
- W !,$$C^XBFUNC("* Queue HOSPITAL LOG for "_ACHSFAC_" "_"*",80)
- W !,$$C^XBFUNC("* Enter '?' at any time for HELP."_" "_"*",80)
- W !,$$C^XBFUNC("*************************************",80)
- SELQBY ;Select method of report.
- K DIR,ACHSQBY,ACHSPAT,ACHSVNDR,ACHSDIAG,ACHSADM
- S DIR("A")="QUEUE HOSPITAL LOG BY",DIR(0)="S^P:PATIENT;S:STATUS TYPE;V:VENDOR;D:DIAGNOSIS",DIR("B")="PATIENT",DIR("?")="^D QBYHELP^ACHSHLPP"
- D ^DIR K DIR
- I $D(DIRUT)!$D(DIROUT) K ACHSQBY G END
- S ACHSQBY=$S("P,S,V,D"[Y:Y,1:"SELQBY")
- I ACHSQBY["S" S ACHSSTAT=""
- G @ACHSQBY
- P ;Select individual or all patients
- S DIR("A")="Include ALL PATIENTS",DIR(0)="Y",DIR("B")="YES",DIR("?",1)="Enter 'Y' or <RETURN> to include all patients",DIR("?")="or enter 'N' to select an individual patient."
- W ! D ^DIR K DIR
- I $D(DIRUT) K ACHSPAT G SELQBY
- G END:$D(DIROUT)
- I Y=1 S ACHSPAT(0)="" G S
- DICP W !! K DIC S DIC="^AUPNPAT(",DIC(0)="AEQM" D ^DIC K DIC
- I +Y<1,'$D(ACHSPAT) G END
- I +Y<1,$D(ACHSPAT) G S
- S:+Y>0 ACHSPAT(+Y)="" G DICP
- V ; Select vendor or all vendors
- S DIR("A")=" S = SPECIFY VENDOR A = ALL VENDORS",DIR(0)="SB^S:SPECIFIED VENDOR;A:ALL VENDORS",DIR("B")="ALL",DIR("?",1)="Enter 'A' or <RETURN> to include all vendors",DIR("?")="or enter 'S' to select a specific vendor."
- W ! D ^DIR K DIR
- I $D(DIRUT) K ACHSVNDR G SELQBY
- G END:$D(DIROUT)
- I Y="A" S ACHSVNDR(0)="" G S
- DICV ; Lookup vendor if single vendor.
- W !!
- K DIC
- S DIC="^AUTTVNDR(",DIC(0)="AEQM"
- D ^DIC
- K DIC
- I +Y<1,'$D(ACHSVNDR) G END
- I +Y<1,$D(ACHSVNDR) G S
- S:+Y>0 ACHSVNDR(+Y)="" G DICV
- D ; Select diagnosis or all diagnoses
- S DIR("A")=" S = SPECIFY DIAGNOSIS A = ALL DIAGNOSES",DIR(0)="SB^S:SPECIFY DIAGNOSIS;A:ALL DIAGNOSIS",DIR("B")="ALL",DIR("?",1)="Enter 'A' or <RETURN> to include all diagnoses",DIR("?")="or enter 'S' to select a specific diagnosis."
- W ! D ^DIR K DIR
- I $D(DIRUT) K ACHSDIAG G SELQBY
- G END:$D(DIROUT)
- I Y="A" S ACHSDIAG(0)="" G S
- DICD W !! K DIC S DIC="^ICD9(",DIC(0)="AEQM" D ^DIC K DIC
- I +Y<1,'$D(ACHSDIAG) G END
- I +Y<1,$D(ACHSDIAG) G S
- S:+Y>0 ACHSDIAG(+Y)="" G DICD
- S ;Select active/non-active/scheduled/all
- K DIR,ACHSATYP
- S DIR("A")="STATUS TYPE",DIR(0)="S^A:Active (Current Inpatients);N:Non-Active (Discharged Patients);S:Scheduled Admissions (Est. DOS) **NOT USED WITH DIAG**;L:List All (of the above)",DIR("B")="List All"
- S DIR("?",1)="Enter 'A' to include current inpatient data only."
- S DIR("?",2)="Enter 'N' to include discharged patient data only."
- S DIR("?",3)="Enter 'S' to include scheduled admission data only. **NOT USED WITH DIAG**"
- S DIR("?")="Enter 'L' to include data on all of the above."
- W ! D ^DIR K DIR
- G END:$D(DIROUT),SELQBY:$D(DIRUT),END:$D(DTOUT),END:$D(DUOUT)
- I Y="S",$D(ACHSDIAG) W *7,*7,!!?5,"*** Scheduled Admissions is unavailable with the Diagnosis option ***" G S
- S ACHSATYP=Y
- SELBEG ;Select beginning date
- S X1=DT,X2=365 D C^%DTC S ACHSMAX=X
- S DIR(0)=$S(ACHSATYP="A":"D^:DT:EX",ACHSATYP="N":"D^:DT:EX",ACHSATYP="S":"D^DT:"_ACHSMAX_":EX",ACHSATYP="L":"D^:DT:EX",1:"??")
- S DIR("A")="Enter the BEGINNING "_$S(ACHSATYP="A":"Active Date",ACHSATYP="N":"Discharge Date",ACHSATYP="S":"Estimated Date of Service",ACHSATYP="L":"date for all status types",1:"")
- W ! D ^DIR K DIR G S:$D(DUOUT),END:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)
- S ACHSBEG=Y,X1=DT,X2=365 D C^%DTC S ACHSMAX=X
- SELEND ;Select ending date
- S DIR(0)=$S(ACHSATYP="A":"D^:DT:EX",ACHSATYP="N":"D^:DT:EX",ACHSATYP="S":"D^DT:"_ACHSMAX_":EX",ACHSATYP="L":"D^:DT:EX",1:"??")
- S DIR("A")="Enter the ENDING "_$S(ACHSATYP="A":"Active Date",ACHSATYP="N":"Discharge Date",ACHSATYP="S":"Estimated Date of Service",ACHSATYP="L":"date for all status types",1:"")
- W ! D ^DIR K DIR G SELBEG:$D(DUOUT),END:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)
- S ACHSEND=Y
- REPTYP ;Choose Report Type
- S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("B")="Summary",DIR("A")=" Report Type ",DIR("B")="SUMMARY",DIR("?")="^D RPTHELP^ACHSHLPP"
- D ^DIR K DIR
- G SELBEG:$D(DUOUT),END:$D(DIROUT)!$D(DTOUT)!$D(DIRUT)
- S ACHSRTYP=Y
- DEVICE ;Device Selection
- W *7,!!?20,"This report may take awhile to compile.",!?9," It is recommended that you QUEUE your output to a PRINTER.",!
- S %ZIS="PQ" D ^%ZIS
- I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" D ^DIR K DIR
- D HOME^%ZIS G END:Y=0,SELQBY:Y=1
- I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHSHLGC
- I $D(IO("S"))!($E(IOST)'="P") G DEVICE
- ZTLOAD ; Load Taskman
- S ZTRTN="^ACHSHLGC",ZTIO="",ZTDESC="HOSPITAL LOG REPORT",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
- F %="ACHSUSR","ACHSQIO","ACHSFAC(","ACHSSRCH","ACHSBEG","ACHSEND" S ZTSAVE(%)=""
- D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS
- END ; Kill vars, quit.
- K ACHSFAC,ACHSMAX,ACHSQIO,ACHSATYP,ACHSUSR,ACHSBEG,ACHSEND,ACHSSTAT
- K DIR,DIROUT,DIRUT,DTOUT,DUOUT
- Q
- ACHSHLGQ ; IHS/ITSC/PMF - QUEUE CHS HOSPITAL LOG SUMMARY ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ; Under Development
- QUIT
- +3 DO ^ACHSVAR
- IF '$DATA(^ACHSF(DUZ(2)))
- QUIT
- +4 KILL ^TMP($JOB)
- +5 SET ACHSUSR=$$USR^ACHS
- SET ACHSFAC=$$LOC^ACHS
- +6 WRITE !,$$C^XBFUNC("*************************************",80)
- +7 WRITE !,$$C^XBFUNC("* Queue HOSPITAL LOG for "_ACHSFAC_" "_"*",80)
- +8 WRITE !,$$C^XBFUNC("* Enter '?' at any time for HELP."_" "_"*",80)
- +9 WRITE !,$$C^XBFUNC("*************************************",80)
- SELQBY ;Select method of report.
- +1 KILL DIR,ACHSQBY,ACHSPAT,ACHSVNDR,ACHSDIAG,ACHSADM
- +2 SET DIR("A")="QUEUE HOSPITAL LOG BY"
- SET DIR(0)="S^P:PATIENT;S:STATUS TYPE;V:VENDOR;D:DIAGNOSIS"
- SET DIR("B")="PATIENT"
- SET DIR("?")="^D QBYHELP^ACHSHLPP"
- +3 DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)!$DATA(DIROUT)
- KILL ACHSQBY
- GOTO END
- +5 SET ACHSQBY=$SELECT("P,S,V,D"[Y:Y,1:"SELQBY")
- +6 IF ACHSQBY["S"
- SET ACHSSTAT=""
- +7 GOTO @ACHSQBY
- P ;Select individual or all patients
- +1 SET DIR("A")="Include ALL PATIENTS"
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("?",1)="Enter 'Y' or <RETURN> to include all patients"
- SET DIR("?")="or enter 'N' to select an individual patient."
- +2 WRITE !
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- KILL ACHSPAT
- GOTO SELQBY
- +4 IF $DATA(DIROUT)
- GOTO END
- +5 IF Y=1
- SET ACHSPAT(0)=""
- GOTO S
- DICP WRITE !!
- KILL DIC
- SET DIC="^AUPNPAT("
- SET DIC(0)="AEQM"
- DO ^DIC
- KILL DIC
- +1 IF +Y<1
- IF '$DATA(ACHSPAT)
- GOTO END
- +2 IF +Y<1
- IF $DATA(ACHSPAT)
- GOTO S
- +3 IF +Y>0
- SET ACHSPAT(+Y)=""
- GOTO DICP
- V ; Select vendor or all vendors
- +1 SET DIR("A")=" S = SPECIFY VENDOR A = ALL VENDORS"
- SET DIR(0)="SB^S:SPECIFIED VENDOR;A:ALL VENDORS"
- SET DIR("B")="ALL"
- SET DIR("?",1)="Enter 'A' or <RETURN> to include all vendors"
- SET DIR("?")="or enter 'S' to select a specific vendor."
- +2 WRITE !
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- KILL ACHSVNDR
- GOTO SELQBY
- +4 IF $DATA(DIROUT)
- GOTO END
- +5 IF Y="A"
- SET ACHSVNDR(0)=""
- GOTO S
- DICV ; Lookup vendor if single vendor.
- +1 WRITE !!
- +2 KILL DIC
- +3 SET DIC="^AUTTVNDR("
- SET DIC(0)="AEQM"
- +4 DO ^DIC
- +5 KILL DIC
- +6 IF +Y<1
- IF '$DATA(ACHSVNDR)
- GOTO END
+7 IF +Y<1
IF $DATA(ACHSVNDR)
GOTO S
+8 IF +Y>0
SET ACHSVNDR(+Y)=""
GOTO DICV
D ; Select diagnosis or all diagnoses
+1 SET DIR("A")=" S = SPECIFY DIAGNOSIS A = ALL DIAGNOSES"
SET DIR(0)="SB^S:SPECIFY DIAGNOSIS;A:ALL DIAGNOSIS"
SET DIR("B")="ALL"
SET DIR("?",1)="Enter 'A' or <RETURN> to include all diagnoses"
SET DIR("?")="or enter 'S' to select a specific diagnosis."
+2 WRITE !
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
KILL ACHSDIAG
GOTO SELQBY
+4 IF $DATA(DIROUT)
GOTO END
+5 IF Y="A"
SET ACHSDIAG(0)=""
GOTO S
DICD WRITE !!
KILL DIC
SET DIC="^ICD9("
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
+1 IF +Y<1
IF '$DATA(ACHSDIAG)
GOTO END
+2 IF +Y<1
IF $DATA(ACHSDIAG)
GOTO S
+3 IF +Y>0
SET ACHSDIAG(+Y)=""
GOTO DICD
S ;Select active/non-active/scheduled/all
+1 KILL DIR,ACHSATYP
+2 SET DIR("A")="STATUS TYPE"
SET DIR(0)="S^A:Active (Current Inpatients);N:Non-Active (Discharged Patients);S:Scheduled Admissions (Est. DOS) **NOT USED WITH DIAG**;L:List All (of the above)"
SET DIR("B")="List All"
+3 SET DIR("?",1)="Enter 'A' to include current inpatient data only."
+4 SET DIR("?",2)="Enter 'N' to include discharged patient data only."
+5 SET DIR("?",3)="Enter 'S' to include scheduled admission data only. **NOT USED WITH DIAG**"
+6 SET DIR("?")="Enter 'L' to include data on all of the above."
+7 WRITE !
DO ^DIR
KILL DIR
+8 IF $DATA(DIROUT)
GOTO END
IF $DATA(DIRUT)
GOTO SELQBY
IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO END
+9 IF Y="S"
IF $DATA(ACHSDIAG)
WRITE *7,*7,!!?5,"*** Scheduled Admissions is unavailable with the Diagnosis option ***"
GOTO S
+10 SET ACHSATYP=Y
SELBEG ;Select beginning date
+1 SET X1=DT
SET X2=365
DO C^%DTC
SET ACHSMAX=X
+2 SET DIR(0)=$SELECT(ACHSATYP="A":"D^:DT:EX",ACHSATYP="N":"D^:DT:EX",ACHSATYP="S":"D^DT:"_ACHSMAX_":EX",ACHSATYP="L":"D^:DT:EX",1:"??")
+3 SET DIR("A")="Enter the BEGINNING "_$SELECT(ACHSATYP="A":"Active Date",ACHSATYP="N":"Discharge Date",ACHSATYP="S":"Estimated Date of Service",ACHSATYP="L":"date for all status types",1:"")
+4 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
GOTO S
IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO END
+5 SET ACHSBEG=Y
SET X1=DT
SET X2=365
DO C^%DTC
SET ACHSMAX=X
SELEND ;Select ending date
+1 SET DIR(0)=$SELECT(ACHSATYP="A":"D^:DT:EX",ACHSATYP="N":"D^:DT:EX",ACHSATYP="S":"D^DT:"_ACHSMAX_":EX",ACHSATYP="L":"D^:DT:EX",1:"??")
+2 SET DIR("A")="Enter the ENDING "_$SELECT(ACHSATYP="A":"Active Date",ACHSATYP="N":"Discharge Date",ACHSATYP="S":"Estimated Date of Service",ACHSATYP="L":"date for all status types",1:"")
+3 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
GOTO SELBEG
IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO END
+4 SET ACHSEND=Y
REPTYP ;Choose Report Type
+1 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("B")="Summary"
SET DIR("A")=" Report Type "
SET DIR("B")="SUMMARY"
SET DIR("?")="^D RPTHELP^ACHSHLPP"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DUOUT)
GOTO SELBEG
IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO END
+4 SET ACHSRTYP=Y
DEVICE ;Device Selection
+1 WRITE *7,!!?20,"This report may take awhile to compile.",!?9," It is recommended that you QUEUE your output to a PRINTER.",!
+2 SET %ZIS="PQ"
DO ^%ZIS
+3 IF POP
WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 DO HOME^%ZIS
IF Y=0
GOTO END
IF Y=1
GOTO SELQBY
+5 IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
WRITE !
IF '$DATA(IO("S"))
DO WAIT^DICD
GOTO ^ACHSHLGC
+6 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
GOTO DEVICE
ZTLOAD ; Load Taskman
+1 SET ZTRTN="^ACHSHLGC"
SET ZTIO=""
SET ZTDESC="HOSPITAL LOG REPORT"
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+2 FOR %="ACHSUSR","ACHSQIO","ACHSFAC(","ACHSSRCH","ACHSBEG","ACHSEND"
SET ZTSAVE(%)=""
+3 DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
END ; Kill vars, quit.
+1 KILL ACHSFAC,ACHSMAX,ACHSQIO,ACHSATYP,ACHSUSR,ACHSBEG,ACHSEND,ACHSSTAT
+2 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 QUIT
