APCL2A1 ; IHS/CMI/LAB - Process APC 1A report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;CMI/TUCSON/LAB fixed FY patch 3
;IHS/CMI/LAB - FILE 200 CHECK
START ;
S APCLBT=$H,APCLJOB=$J
K ^XTMP("APCL2A",APCLJOB,APCLBT)
D XTMP^APCLOSUT("APCL2A","PCC 1A REPORT")
;beginning Y2K fix
;S X1=APCLFY,X2=-1 D C^%DTC S APCLSD=X S X1=APCLFY,X2=365 D C^%DTC S APCLFYE=$E(X,1,3)_"0930" ;Y2000
;end Y2K
V ; Run by visit date
S APCLGRAN=0
S X=0 F S X=$O(APCLLOCS(X)) Q:X'=+X S APCLGRAN(X)=0
S APCLSD=APCLSD_".9999" F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLFYE) D V1
;
XIT ;
D EOJ
S APCLET=$H
Q
V1 ;
S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLSD,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)) S APCLVREC=^(0) D PROC,EOJ
Q
PROC ;
S DFN=$P(APCLVREC,U,5)
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
;I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
Q:$P(APCLVREC,U,6)=""
I $D(APCLLOCS),'$D(APCLLOCS($P(APCLVREC,U,6))) Q
S APCLVLOC=$P(APCLVREC,U,6)
Q:'$$APCWL^APCLV(APCLVDFN) ;no wl reportable
;Q:$$PRIMPOV^APCLV(APCLVDFN,"C")=".9999"
S APCLCLIN=$P(APCLVREC,U,8) S APCLCLN=$S(APCLCLIN:$P(^DIC(40.7,APCLCLIN,0),U,2),1:25)
I APCLCLN=56,$D(^AUPNVMED("AD",APCLVDFN)) S APCLDPTR=$O(^DIC(7,"D","09",0)) I 1
E S APCLDPTR=$$PRIMPROV^APCLV(APCLVDFN,"F")
I APCLDPTR="" S APCLDPTR="??"
S APCLMOS=+$E(APCLSD,4,5)
S ^(APCLMOS)=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"MODISC",$$PDC(APCLDPTR),APCLDPTR,APCLMOS)):^(APCLMOS)+1,1:1)
S ^(APCLDPTR)=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"DISCTOT",$$PDC(APCLDPTR),APCLDPTR)):^(APCLDPTR)+1,1:1)
S APCLGRAN(APCLVLOC)=APCLGRAN(APCLVLOC)+1
I $P($G(^AUPNVSIT(APCLVDFN,11)),U,6)="" D
.S ^("NO EXPORT")=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"NO EXPORT")):^("NO EXPORT")+1,1:1)
.I $D(^AUPNVSIT("ADWO",$P(APCLVREC,U,2),APCLVDFN)) S ^("IN XREF")=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"IN XREF")):^("IN XREF")+1,1:1) Q
.I $D(^AUPNVSIT("ADWO",$P($P(APCLVREC,U,13),"."),APCLVDFN)) S ^("IN XREF")=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"IN XREF")):^("IN XREF")+1,1:1) Q
;TABLE VISITS AND COUNT DUPLICATES BY PATIENT,DATE,CLINIC
;S Q=$$PRIMPROV^APCLV(APCLVDFN,"I")
;Q:Q=""
;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)) S ^("DUPLICATE")=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"DUPLICATE")):^("DUPLICATE")+1,1:1)
;E S ^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)=""
Q
PDC(D) ;
I $G(D)="" Q ""
I D="??" Q "ZZ"
I '$D(^DIC(7,D,9999999)) Q "ZZ"
S D=$P(^DIC(7,D,9999999),U)
I D="" Q "ZZ"
I $E(D)="0" S D=+D
Q D
;
EOJ K APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLDPTR,APCLLOCC,APCLCLN
K X,X1,X2
Q
;
;
APCL2A1 ; IHS/CMI/LAB - Process APC 1A report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;CMI/TUCSON/LAB fixed FY patch 3
+3 ;IHS/CMI/LAB - FILE 200 CHECK
START ;
+1 SET APCLBT=$HOROLOG
SET APCLJOB=$JOB
+2 KILL ^XTMP("APCL2A",APCLJOB,APCLBT)
+3 DO XTMP^APCLOSUT("APCL2A","PCC 1A REPORT")
+4 ;beginning Y2K fix
+5 ;S X1=APCLFY,X2=-1 D C^%DTC S APCLSD=X S X1=APCLFY,X2=365 D C^%DTC S APCLFYE=$E(X,1,3)_"0930" ;Y2000
+6 ;end Y2K
V ; Run by visit date
+1 SET APCLGRAN=0
+2 SET X=0
FOR
SET X=$ORDER(APCLLOCS(X))
IF X'=+X
QUIT
SET APCLGRAN(X)=0
+3 SET APCLSD=APCLSD_".9999"
FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD=""!((APCLSD\1)>APCLFYE)
QUIT
DO V1
+4 ;
XIT ;
+1 DO EOJ
+2 SET APCLET=$HOROLOG
+3 QUIT
V1 ;
+1 SET APCLVDFN=""
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLSD,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
SET APCLVREC=^(0)
DO PROC
DO EOJ
+2 QUIT
PROC ;
+1 SET DFN=$PIECE(APCLVREC,U,5)
+2 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+3 ;I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
+4 IF $PIECE(APCLVREC,U,6)=""
QUIT
+5 IF $DATA(APCLLOCS)
IF '$DATA(APCLLOCS($PIECE(APCLVREC,U,6)))
QUIT
+6 SET APCLVLOC=$PIECE(APCLVREC,U,6)
+7 ;no wl reportable
IF '$$APCWL^APCLV(APCLVDFN)
QUIT
+8 ;Q:$$PRIMPOV^APCLV(APCLVDFN,"C")=".9999"
+9 SET APCLCLIN=$PIECE(APCLVREC,U,8)
SET APCLCLN=$SELECT(APCLCLIN:$PIECE(^DIC(40.7,APCLCLIN,0),U,2),1:25)
+10 IF APCLCLN=56
IF $DATA(^AUPNVMED("AD",APCLVDFN))
SET APCLDPTR=$ORDER(^DIC(7,"D","09",0))
IF 1
+11 IF '$TEST
SET APCLDPTR=$$PRIMPROV^APCLV(APCLVDFN,"F")
+12 IF APCLDPTR=""
SET APCLDPTR="??"
+13 SET APCLMOS=+$EXTRACT(APCLSD,4,5)
+14 SET ^(APCLMOS)=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"MODISC",$$PDC(APCLDPTR),APCLDPTR,APCLMOS)):^(APCLMOS)+1,1:1)
+15 SET ^(APCLDPTR)=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"DISCTOT",$$PDC(APCLDPTR),APCLDPTR)):^(APCLDPTR)+1,1:1)
+16 SET APCLGRAN(APCLVLOC)=APCLGRAN(APCLVLOC)+1
+17 IF $PIECE($GET(^AUPNVSIT(APCLVDFN,11)),U,6)=""
Begin DoDot:1
+18 SET ^("NO EXPORT")=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"NO EXPORT")):^("NO EXPORT")+1,1:1)
+19 IF $DATA(^AUPNVSIT("ADWO",$PIECE(APCLVREC,U,2),APCLVDFN))
SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"IN XREF")):^("IN XREF")+1,1:1)
QUIT
+20 IF $DATA(^AUPNVSIT("ADWO",$PIECE($PIECE(APCLVREC,U,13),"."),APCLVDFN))
SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"IN XREF")):^("IN XREF")+1,1:1)
QUIT
End DoDot:1
+21 ;TABLE VISITS AND COUNT DUPLICATES BY PATIENT,DATE,CLINIC
+22 ;S Q=$$PRIMPROV^APCLV(APCLVDFN,"I")
+23 ;Q:Q=""
+24 ;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)) S ^("DUPLICATE")=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,"DUPLICATE")):^("DUPLICATE")+1,1:1)
+25 ;E S ^XTMP("APCL2A",APCLJOB,APCLBT,APCLVLOC,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)=""
+26 QUIT
PDC(D) ;
+1 IF $GET(D)=""
QUIT ""
+2 IF D="??"
QUIT "ZZ"
+3 IF '$DATA(^DIC(7,D,9999999))
QUIT "ZZ"
+4 SET D=$PIECE(^DIC(7,D,9999999),U)
+5 IF D=""
QUIT "ZZ"
+6 IF $EXTRACT(D)="0"
SET D=+D
+7 QUIT D
+8 ;
EOJ KILL APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLDPTR,APCLLOCC,APCLCLN
+1 KILL X,X1,X2
+2 QUIT
+3 ;
+4 ;
