- ABPAAGEQ ;QUEUE PVT INS AGED CLAIMS REPORT; [ 07/25/91 10:33 AM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- W !!,"<<< SORRY, ACCESS DENIED!!! >>>",!! G ZTLEND
- ;--------------------------------------------------------------------
- HEAD ;PROCEDURE TO DRAW SCREEN HEADING
- S ABPAHD1="OUTSTANDING CLAIMS Reports" D HEADER^ABPAMAIN
- Q
- ;--------------------------------------------------------------------
- TYPE K DIR,ABPA("RTYP")
- S DIR(0)="SO^1:Detailed Open Items;2:Aged Claim Summary;"
- S DIR("A")="Select REPORT TYPE" D ^DIR I Y S ABPA("RTYP")=+Y
- E D
- .K ABPAMESS S ABPAMESS="NO REPORT TYPE SELECTED - JOB ABORTED" W *7
- .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- Q
- ;--------------------------------------------------------------------
- INSURER ;PROCEDURE TO SELECT INSURERS TO INCLUDE
- S ABPA("INS")=0 F I=0:0 D Q:+%>0
- .W !!,"Use ALL INSURERS" S %=1 D YN^DICN
- I +%=1 S ABPA("INS")="ALL" Q
- F J=0:0 D Q:+Y<1
- .K DIC S DIC="^AUTNINS(",DIC(0)="AEMQ" W ! D ^DIC Q:+Y<1
- .S ABPA("INS")=ABPA("INS")+1,ABPA("INS",ABPA("INS"))=+Y
- Q
- ;--------------------------------------------------------------------
- DEVICE ;PROCEDURE TO SELECT PRINTER DEVICE TO USE FOR THE REPORT
- S %IS="NP",IOP="Q" W !! D ^%ZIS
- I POP=1 D H 2 S IOP=$I D ^%ZIS K IOP Q
- .K ABPAMESS S ABPAMESS="NO DEVICE SELECTED - JOB ABORTED" W *7
- .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- I $E(IOST,1)'="P" D S IOP=$I D ^%ZIS K IOP G DEVICE
- .W *7,?5,"<<< MUST BE A PRINTER DEVICE >>>"
- S ABPA("IO")=+IO
- Q
- ;--------------------------------------------------------------------
- ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
- I ABPA("RTYP")=1 S ZTRTN="MAIN^ABPAAGE1" D
- .S ZTDESC="COMPILE DETAILED OPEN ITEMS"
- I ABPA("RTYP")=2 S ZTRTN="MAIN^ABPAAGS1" D
- .S ZTDESC="COMPILE AGED CLAIMS SUMMARY"
- S ZTSAVE("BDT")="",ZTSAVE("EDT")="",ZTSAVE("ABPATLE")="",ZTIO=""
- S ZTSAVE("ABPA(")="",ZTSAVE("ABPAOPT(")="" D ^%ZTLOAD
- I $D(ZTSK)=1 W !!,"REQUEST QUEUED!! Task number: ",ZTSK H 3
- Q
- ;--------------------------------------------------------------------
- ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
- K %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
- K DIC,%,IOP,I,DIR
- Q
- ;--------------------------------------------------------------------
- MAIN ;ENTRY POINT - THE STARTING POINT FOR ENTERING THIS PROGRAM
- D ZTLEND,HEAD,TYPE I $D(ABPA("RTYP"))'=1 D ZTLEND Q
- D ^ABPADATE I '$D(BDT)!'$D(EDT) D D ZTLEND Q
- .K ABPAMESS S ABPAMESS="INVALID REPORT PERIOD - JOB ABORTED" W *7
- .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- D INSURER I ABPA("INS")'="ALL"&(+ABPA("INS")'>0) D D ZTLEND Q
- .K ABPAMESS S ABPAMESS="NO INSURER(S) SELECTED - JOB ABORTED" W *7
- .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- D DEVICE I $D(ABPA("IO"))'=1 D ZTLEND Q
- D ZTLOAD,ZTLEND
- Q
- ABPAAGEQ ;QUEUE PVT INS AGED CLAIMS REPORT; [ 07/25/91 10:33 AM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- +2 WRITE !!,"<<< SORRY, ACCESS DENIED!!! >>>",!!
- GOTO ZTLEND
- +3 ;--------------------------------------------------------------------
- HEAD ;PROCEDURE TO DRAW SCREEN HEADING
- +1 SET ABPAHD1="OUTSTANDING CLAIMS Reports"
- DO HEADER^ABPAMAIN
- +2 QUIT
- +3 ;--------------------------------------------------------------------
- TYPE KILL DIR,ABPA("RTYP")
- +1 SET DIR(0)="SO^1:Detailed Open Items;2:Aged Claim Summary;"
- +2 SET DIR("A")="Select REPORT TYPE"
- DO ^DIR
- IF Y
- SET ABPA("RTYP")=+Y
- +3 IF '$TEST
- Begin DoDot:1
- +4 KILL ABPAMESS
- SET ABPAMESS="NO REPORT TYPE SELECTED - JOB ABORTED"
- WRITE *7
- +5 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- End DoDot:1
- +6 QUIT
- +7 ;--------------------------------------------------------------------
- INSURER ;PROCEDURE TO SELECT INSURERS TO INCLUDE
- +1 SET ABPA("INS")=0
- FOR I=0:0
- Begin DoDot:1
- +2 WRITE !!,"Use ALL INSURERS"
- SET %=1
- DO YN^DICN
- End DoDot:1
- IF +%>0
- QUIT
- +3 IF +%=1
- SET ABPA("INS")="ALL"
- QUIT
- +4 FOR J=0:0
- Begin DoDot:1
- +5 KILL DIC
- SET DIC="^AUTNINS("
- SET DIC(0)="AEMQ"
- WRITE !
- DO ^DIC
- IF +Y<1
- QUIT
- +6 SET ABPA("INS")=ABPA("INS")+1
- SET ABPA("INS",ABPA("INS"))=+Y
- End DoDot:1
- IF +Y<1
- QUIT
- +7 QUIT
- +8 ;--------------------------------------------------------------------
- DEVICE ;PROCEDURE TO SELECT PRINTER DEVICE TO USE FOR THE REPORT
- +1 SET %IS="NP"
- SET IOP="Q"
- WRITE !!
- DO ^%ZIS
- +2 IF POP=1
- Begin DoDot:1
- +3 KILL ABPAMESS
- SET ABPAMESS="NO DEVICE SELECTED - JOB ABORTED"
- WRITE *7
- +4 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- End DoDot:1
- HANG 2
- SET IOP=$IO
- DO ^%ZIS
- KILL IOP
- QUIT
- +5 IF $EXTRACT(IOST,1)'="P"
- Begin DoDot:1
- +6 WRITE *7,?5,"<<< MUST BE A PRINTER DEVICE >>>"
- End DoDot:1
- SET IOP=$IO
- DO ^%ZIS
- KILL IOP
- GOTO DEVICE
- +7 SET ABPA("IO")=+IO
- +8 QUIT
- +9 ;--------------------------------------------------------------------
- ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
- +1 IF ABPA("RTYP")=1
- SET ZTRTN="MAIN^ABPAAGE1"
- Begin DoDot:1
- +2 SET ZTDESC="COMPILE DETAILED OPEN ITEMS"
- End DoDot:1
- +3 IF ABPA("RTYP")=2
- SET ZTRTN="MAIN^ABPAAGS1"
- Begin DoDot:1
- +4 SET ZTDESC="COMPILE AGED CLAIMS SUMMARY"
- End DoDot:1
- +5 SET ZTSAVE("BDT")=""
- SET ZTSAVE("EDT")=""
- SET ZTSAVE("ABPATLE")=""
- SET ZTIO=""
- +6 SET ZTSAVE("ABPA(")=""
- SET ZTSAVE("ABPAOPT(")=""
- DO ^%ZTLOAD
- +7 IF $DATA(ZTSK)=1
- WRITE !!,"REQUEST QUEUED!! Task number: ",ZTSK
- HANG 3
- +8 QUIT
- +9 ;--------------------------------------------------------------------
- ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
- +1 KILL %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
- +2 KILL DIC,%,IOP,I,DIR
- +3 QUIT
- +4 ;--------------------------------------------------------------------
- MAIN ;ENTRY POINT - THE STARTING POINT FOR ENTERING THIS PROGRAM
- +1 DO ZTLEND
- DO HEAD
- DO TYPE
- IF $DATA(ABPA("RTYP"))'=1
- DO ZTLEND
- QUIT
- +2 DO ^ABPADATE
- IF '$DATA(BDT)!'$DATA(EDT)
- Begin DoDot:1
- +3 KILL ABPAMESS
- SET ABPAMESS="INVALID REPORT PERIOD - JOB ABORTED"
- WRITE *7
- +4 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- End DoDot:1
- DO ZTLEND
- QUIT
- +5 DO INSURER
- IF ABPA("INS")'="ALL"&(+ABPA("INS")'>0)
- Begin DoDot:1
- +6 KILL ABPAMESS
- SET ABPAMESS="NO INSURER(S) SELECTED - JOB ABORTED"
- WRITE *7
- +7 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- End DoDot:1
- DO ZTLEND
- QUIT
- +8 DO DEVICE
- IF $DATA(ABPA("IO"))'=1
- DO ZTLEND
- QUIT
- +9 DO ZTLOAD
- DO ZTLEND
- +10 QUIT
