- ABPVDG01 ;QUEUE PRIVATE INSURANCE ELIG I/P ADMIT REPORT; [ 06/04/91 12:45 PM ]
- ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- START D ZTLEND,INIT,TITLE
- D DATES I '$D(ABPV("BEG"))!'$D(ABPV("END")) D ZTLEND Q
- D DEVICE I $D(ABPV("IO"))'=1 D ZTLEND Q
- D ZTLOAD
- Q
- ;
- INIT D DT^DICRW I $D(DUZ(2))'=1 D
- .S DUZ(2)=$P(^AUTTSITE(1,0),"^")
- S ABPV("SITE")=DUZ(2)
- S ABPV("SITENAME")=$P(^DIC(4,DUZ(2),0),"^")
- Q
- ;
- TITLE K ABPV("HD")
- S ABPV("HD",1)="P R I V A T E I N S U R A N C E E L I G I B L E"
- S ABPV("HD",2)="IN-PATIENT ADMISSIONS REPORT" D ^ABPVHD
- Q
- ;
- DATES D ^ABPVDATE
- S:$D(BDT)=1 ABPV("BEG")=BDT S:$D(EDT)=1 ABPV("END")=EDT K BDT,EDT
- Q
- ;
- DEVICE S %IS="NP",IOP="Q" W !! D ^%ZIS
- I +IO=0 D H 3 Q
- .W *7,!!?5,"<<< NO DEVICE SELECTED - JOB ABORTED >>>"
- S ABPV("IO")=+IO
- Q
- ;
- ZTLOAD S ZTRTN="^ABPVDG02",ZTSAVE("ABPV(")="",ZTIO=""
- S ZTDESC="COMPILE PVT INS ELIGIBLE IN-PATIENT ADMISSIONS"
- D ^%ZTLOAD I $D(ZTSK)=1 W !!,"REQUEST QUEUED!! Task number: ",ZTSK
- H 3
- ZTLEND K ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,R,I
- S IOP=$I D ^%ZIS K IOP
- Q
- ABPVDG01 ;QUEUE PRIVATE INSURANCE ELIG I/P ADMIT REPORT; [ 06/04/91 12:45 PM ]
- +1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- START DO ZTLEND
- DO INIT
- DO TITLE
- +1 DO DATES
- IF '$DATA(ABPV("BEG"))!'$DATA(ABPV("END"))
- DO ZTLEND
- QUIT
- +2 DO DEVICE
- IF $DATA(ABPV("IO"))'=1
- DO ZTLEND
- QUIT
- +3 DO ZTLOAD
- +4 QUIT
- +5 ;
- INIT DO DT^DICRW
- IF $DATA(DUZ(2))'=1
- Begin DoDot:1
- +1 SET DUZ(2)=$PIECE(^AUTTSITE(1,0),"^")
- End DoDot:1
- +2 SET ABPV("SITE")=DUZ(2)
- +3 SET ABPV("SITENAME")=$PIECE(^DIC(4,DUZ(2),0),"^")
- +4 QUIT
- +5 ;
- TITLE KILL ABPV("HD")
- +1 SET ABPV("HD",1)="P R I V A T E I N S U R A N C E E L I G I B L E"
- +2 SET ABPV("HD",2)="IN-PATIENT ADMISSIONS REPORT"
- DO ^ABPVHD
- +3 QUIT
- +4 ;
- DATES DO ^ABPVDATE
- +1 IF $DATA(BDT)=1
- SET ABPV("BEG")=BDT
- IF $DATA(EDT)=1
- SET ABPV("END")=EDT
- KILL BDT,EDT
- +2 QUIT
- +3 ;
- DEVICE SET %IS="NP"
- SET IOP="Q"
- WRITE !!
- DO ^%ZIS
- +1 IF +IO=0
- Begin DoDot:1
- +2 WRITE *7,!!?5,"<<< NO DEVICE SELECTED - JOB ABORTED >>>"
- End DoDot:1
- HANG 3
- QUIT
- +3 SET ABPV("IO")=+IO
- +4 QUIT
- +5 ;
- ZTLOAD SET ZTRTN="^ABPVDG02"
- SET ZTSAVE("ABPV(")=""
- SET ZTIO=""
- +1 SET ZTDESC="COMPILE PVT INS ELIGIBLE IN-PATIENT ADMISSIONS"
- +2 DO ^%ZTLOAD
- IF $DATA(ZTSK)=1
- WRITE !!,"REQUEST QUEUED!! Task number: ",ZTSK
- +3 HANG 3
- ZTLEND KILL ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,R,I
- +1 SET IOP=$IO
- DO ^%ZIS
- KILL IOP
- +2 QUIT
