- APCLAP31 ; IHS/CMI/LAB - visits by provider process ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- S APCLBT=$H
- K ^XTMP("APCLAP3",APCLJOB,APCLBTH)
- D XTMP^APCLOSUT("APCLAP3","PCC - ALL VISITS BY PROV")
- V ; Run by visit date
- S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
- ;
- END ;
- S APCLET=$H
- Q
- V1 ;
- S V="" F S V=$O(^AUPNVSIT("B",APCLODAT,V)) Q:V'=+V I $D(^AUPNVSIT(V,0)) S APCLVREC=^(0) D
- .K APCLSKIP
- .Q:'$P(APCLVREC,U,9)
- .Q:$P(APCLVREC,U,11)
- .Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
- .I $$CHKLOC^APCLOCCK(APCLLOC,$P(APCLVREC,U,6))=0 Q
- .Q:'$D(^AUPNVPOV("AD",V))
- .Q:'$D(^AUPNVPRV("AD",V))
- .S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
- .S APCLCAT=$P(APCLVREC,U,7)
- .S DIQ(0)="E",DA=V,DIC="^AUPNVSIT(",DR=".07" D EN^DIQ1 S APCLCAT=^UTILITY("DIQ1",$J,9000010,DA,".07","E")
- .K ^UTILITY("DIQ1",$J)
- .S B=0 F S B=$O(^AUPNVPRV("AD",V,B)) Q:B="" D
- ..I APCLPRIM,$P(^AUPNVPRV(B,0),U,4)'="P" Q
- ..S P=$P(^AUPNVPRV(B,0),U)
- ..S F=0
- ..D @APCLPSRT
- ..Q:'F
- ..S ^(APCLCAT)=$S($D(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,APCLVLOC,APCLCAT)):^(APCLCAT)+1,1:1)
- ..S ^("TOTAL")=$S($D(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,"TOTAL")):^("TOTAL")+1,1:1)
- ..Q
- .Q
- Q
- ;
- P ;
- I $D(APCLCDIS) S S="" D D Q:S=""
- S S=P,F=1
- Q
- ;
- O ;
- Q:APCLPROV'=P
- S S=P,F=1
- Q
- ;
- D ;
- I $P(^DD(9000010.06,.01,0),U,2)[6 G D6
- Q:'$D(^VA(200,P))
- S Y=$$PROVCLS^XBFUNC1(P,"I")
- Q:'Y
- Q:APCLDISC'=Y
- S S=APCLDISC
- S F=1
- Q
- D6 ;
- Q:'$D(^DIC(6,P))
- S Y=$P(^DIC(6,P,0),U,4)
- Q:Y=""
- Q:APCLDISC'=Y
- S S=APCLDISC
- S F=1
- Q
- ;
- A ;
- I $P(^DD(9000010.06,.01,0),U,2)[6 G A6
- Q:'$D(^VA(200,P))
- S Y=$$PROVCLS^XBFUNC1(P,"I")
- Q:'Y
- S S=Y
- S F=1
- Q
- A6 ;
- Q:'$D(^DIC(6,P))
- S Y=$P(^DIC(6,P,0),U,4)
- Q:Y=""
- S S=Y
- S F=1
- Q
- ;
- APCLAP31 ; IHS/CMI/LAB - visits by provider process ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- +1 SET APCLBT=$HOROLOG
- +2 KILL ^XTMP("APCLAP3",APCLJOB,APCLBTH)
- +3 DO XTMP^APCLOSUT("APCLAP3","PCC - ALL VISITS BY PROV")
- V ; Run by visit date
- +1 SET APCLODAT=APCLSD_".9999"
- FOR
- SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
- IF APCLODAT=""!((APCLODAT\1)>APCLED)
- QUIT
- DO V1
- +2 ;
- END ;
- +1 SET APCLET=$HOROLOG
- +2 QUIT
- V1 ;
- +1 SET V=""
- FOR
- SET V=$ORDER(^AUPNVSIT("B",APCLODAT,V))
- IF V'=+V
- QUIT
- IF $DATA(^AUPNVSIT(V,0))
- SET APCLVREC=^(0)
- Begin DoDot:1
- +2 KILL APCLSKIP
- +3 IF '$PIECE(APCLVREC,U,9)
- QUIT
- +4 IF $PIECE(APCLVREC,U,11)
- QUIT
- +5 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
- QUIT
- +6 IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(APCLVREC,U,6))=0
- QUIT
- +7 IF '$DATA(^AUPNVPOV("AD",V))
- QUIT
- +8 IF '$DATA(^AUPNVPRV("AD",V))
- QUIT
- +9 SET APCLVLOC=$PIECE(APCLVREC,U,6)
- IF APCLVLOC=""
- QUIT
- +10 SET APCLCAT=$PIECE(APCLVREC,U,7)
- +11 SET DIQ(0)="E"
- SET DA=V
- SET DIC="^AUPNVSIT("
- SET DR=".07"
- DO EN^DIQ1
- SET APCLCAT=^UTILITY("DIQ1",$JOB,9000010,DA,".07","E")
- +12 KILL ^UTILITY("DIQ1",$JOB)
- +13 SET B=0
- FOR
- SET B=$ORDER(^AUPNVPRV("AD",V,B))
- IF B=""
- QUIT
- Begin DoDot:2
- +14 IF APCLPRIM
- IF $PIECE(^AUPNVPRV(B,0),U,4)'="P"
- QUIT
- +15 SET P=$PIECE(^AUPNVPRV(B,0),U)
- +16 SET F=0
- +17 DO @APCLPSRT
- +18 IF 'F
- QUIT
- +19 SET ^(APCLCAT)=$SELECT($DATA(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,APCLVLOC,APCLCAT)):^(APCLCAT)+1,1:1)
- +20 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,"TOTAL")):^("TOTAL")+1,1:1)
- +21 QUIT
- End DoDot:2
- +22 QUIT
- End DoDot:1
- +23 QUIT
- +24 ;
- P ;
- +1 IF $DATA(APCLCDIS)
- SET S=""
- DO D
- IF S=""
- QUIT
- +2 SET S=P
- SET F=1
- +3 QUIT
- +4 ;
- O ;
- +1 IF APCLPROV'=P
- QUIT
- +2 SET S=P
- SET F=1
- +3 QUIT
- +4 ;
- D ;
- +1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
- GOTO D6
- +2 IF '$DATA(^VA(200,P))
- QUIT
- +3 SET Y=$$PROVCLS^XBFUNC1(P,"I")
- +4 IF 'Y
- QUIT
- +5 IF APCLDISC'=Y
- QUIT
- +6 SET S=APCLDISC
- +7 SET F=1
- +8 QUIT
- D6 ;
- +1 IF '$DATA(^DIC(6,P))
- QUIT
- +2 SET Y=$PIECE(^DIC(6,P,0),U,4)
- +3 IF Y=""
- QUIT
- +4 IF APCLDISC'=Y
- QUIT
- +5 SET S=APCLDISC
- +6 SET F=1
- +7 QUIT
- +8 ;
- A ;
- +1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
- GOTO A6
- +2 IF '$DATA(^VA(200,P))
- QUIT
- +3 SET Y=$$PROVCLS^XBFUNC1(P,"I")
- +4 IF 'Y
- QUIT
- +5 SET S=Y
- +6 SET F=1
- +7 QUIT
- A6 ;
- +1 IF '$DATA(^DIC(6,P))
- QUIT
- +2 SET Y=$PIECE(^DIC(6,P,0),U,4)
- +3 IF Y=""
- QUIT
- +4 SET S=Y
- +5 SET F=1
- +6 QUIT
- +7 ;
