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

ABPVOP02.m

Go to the documentation of this file.
ABPVOP02 ;TALLY PRIVATE INSURANCE ELIG O/P VISIT REPORT; [ 06/02/91  12:49 PM ]
 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START D INIT I ABPV("GLOB")=0 D  Q
 .S ^%ZTSK(ZTSK,"ERR")="I COULD NOT DETERMINE YOUR 'APC' GLOBAL TYPE"
 D XTRACT,ZTLOAD
 Q
 ;
INIT S ABPV("TOTAL")=0,ABPV("HITS")=0,ABPV("TASK")=ZTSK
 S ABPV("GLOB")=$S($D(^AAPCRCDS):"^AAPCRCDS(",$D(^AAPCDATA):"^AAPCDATA(",1:0)
 Q
 ;
XTRACT S A("ADOS")=ABPV("BEG")-1
A S ABPV("IND")=ABPV("GLOB")_"""APC"",A(""ADOS""))"
 S A("ADOS")=$O(@ABPV("IND")) Q:+A("ADOS")=0!(A("ADOS")>ABPV("END"))
 S A("ADFN")=0
A1 S ABPV("IND")=ABPV("GLOB")_"""APC"",A(""ADOS""),ABPV(""SITE""),A(""ADFN""))"
 S A("ADFN")=$O(@ABPV("IND")) G A:+A("ADFN")=0
 S ABPV("IND")=ABPV("GLOB")_"""APC"",A(""ADOS""),ABPV(""SITE""),A(""ADFN""),X)"
 S X=0 F A("SVCS")=1:1 S X=$O(@ABPV("IND")) Q:+X=0
 S A("SVCS")=A("SVCS")-1,ABPV("TOTAL")=ABPV("TOTAL")+A("SVCS")
 I $D(^AUPNPRVT(A("ADFN"),0))=0 G A1
 S ABPV("HITS")=ABPV("HITS")+A("SVCS")
 S ^%ZTSK(ABPV("TASK"),ABPV("SITE"),A("ADOS"),A("ADFN"))=A("SVCS")
 G A1
 ;
ZTLOAD S ZTRTN="^ABPVOP03",ZTDTH=$H,ZTIO=ABPV("IO"),ZTSAVE("ABPV(")=""
 S ZTDESC="PRINT PVT INS ELIGIBLE APC VISITS"
 D ^%ZTLOAD
ZTLEND K ABPV,ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,A,X,Y,DIC,DIE,DA
 K DR,ZTIO,R,I
 Q