- APCL1A1 ; 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("APCL1A",APCLJOB,APCLBT)
- D XTMP^APCLOSUT("APCL1A","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 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
- 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("APCL1A",APCLJOB,APCLBT,"MODISC",$$PDC(APCLDPTR),APCLDPTR,APCLMOS)):^(APCLMOS)+1,1:1)
- S ^(APCLDPTR)=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"DISCTOT",$$PDC(APCLDPTR),APCLDPTR)):^(APCLDPTR)+1,1:1)
- S APCLGRAN=APCLGRAN+1
- I $P($G(^AUPNVSIT(APCLVDFN,11)),U,6)="" D
- .S ^("NO EXPORT")=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT")+1,1:1)
- .I $D(^AUPNVSIT("ADWO",$P(APCLVREC,U,2),APCLVDFN)) S ^("IN XREF")=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1) Q
- .I $D(^AUPNVSIT("ADWO",$P($P(APCLVREC,U,13),"."),APCLVDFN)) S ^("IN XREF")=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"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("APCL1A",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)) S ^("DUPLICATE")=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"DUPLICATE")):^("DUPLICATE")+1,1:1)
- ;E S ^XTMP("APCL1A",APCLJOB,APCLBT,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
- ;
- ;
- APCL1A1 ; 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("APCL1A",APCLJOB,APCLBT)
- +3 DO XTMP^APCLOSUT("APCL1A","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 APCLSD=APCLSD_".9999"
- FOR
- SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
- IF APCLSD=""!((APCLSD\1)>APCLFYE)
- QUIT
- DO V1
- +3 ;
- 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 IF APCLLOC]""
- IF APCLLOC'=$PIECE(APCLVREC,U,6)
- QUIT
- +4 SET APCLVLOC=$PIECE(APCLVREC,U,6)
- +5 ;no wl reportable
- IF '$$APCWL^APCLV(APCLVDFN)
- QUIT
- +6 ;Q:$$PRIMPOV^APCLV(APCLVDFN,"C")=".9999"
- +7 SET APCLCLIN=$PIECE(APCLVREC,U,8)
- SET APCLCLN=$SELECT(APCLCLIN:$PIECE(^DIC(40.7,APCLCLIN,0),U,2),1:25)
- +8 IF APCLCLN=56
- IF $DATA(^AUPNVMED("AD",APCLVDFN))
- SET APCLDPTR=$ORDER(^DIC(7,"D","09",0))
- IF 1
- +9 IF '$TEST
- SET APCLDPTR=$$PRIMPROV^APCLV(APCLVDFN,"F")
- +10 IF APCLDPTR=""
- SET APCLDPTR="??"
- +11 SET APCLMOS=+$EXTRACT(APCLSD,4,5)
- +12 SET ^(APCLMOS)=$SELECT($DATA(^XTMP("APCL1A",APCLJOB,APCLBT,"MODISC",$$PDC(APCLDPTR),APCLDPTR,APCLMOS)):^(APCLMOS)+1,1:1)
- +13 SET ^(APCLDPTR)=$SELECT($DATA(^XTMP("APCL1A",APCLJOB,APCLBT,"DISCTOT",$$PDC(APCLDPTR),APCLDPTR)):^(APCLDPTR)+1,1:1)
- +14 SET APCLGRAN=APCLGRAN+1
- +15 IF $PIECE($GET(^AUPNVSIT(APCLVDFN,11)),U,6)=""
- Begin DoDot:1
- +16 SET ^("NO EXPORT")=$SELECT($DATA(^XTMP("APCL1A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT")+1,1:1)
- +17 IF $DATA(^AUPNVSIT("ADWO",$PIECE(APCLVREC,U,2),APCLVDFN))
- SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCL1A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1)
- QUIT
- +18 IF $DATA(^AUPNVSIT("ADWO",$PIECE($PIECE(APCLVREC,U,13),"."),APCLVDFN))
- SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCL1A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1)
- QUIT
- End DoDot:1
- +19 ;TABLE VISITS AND COUNT DUPLICATES BY PATIENT,DATE,CLINIC
- +20 ;S Q=$$PRIMPROV^APCLV(APCLVDFN,"I")
- +21 ;Q:Q=""
- +22 ;I $D(^XTMP("APCL1A",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)) S ^("DUPLICATE")=$S($D(^XTMP("APCL1A",APCLJOB,APCLBT,"DUPLICATE")):^("DUPLICATE")+1,1:1)
- +23 ;E S ^XTMP("APCL1A",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN,Q)=""
- +24 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 ;
