Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPVPCC1

ABPVPCC1.m

Go to the documentation of this file.
ABPVPCC1 ;QUEUE PVT INS ELIG O/P VISITS REPORT; [ 06/04/91  12:43 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)="AMBULATORY VISITS 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="^ABPVPCC2",ZTSAVE("ABPV(")="",ZTIO=""
 S ZTDESC="COMPILE PVT INS ELIGIBLE PCC VISITS"
 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