- APCLCV1 ; IHS/CMI/LAB - Indian Beneficiary Calendar Year Visit Summary ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;APCL1 = New Patients 1st Visit (Indian)
- ;APCL2 = Est Patients 1st Visit (Indian)
- ;APCL3 = Total 1st Visits (Indian)
- ;APCL4 = Additional Visits (2nd,3rd, etc.) (Indian)
- ;APCLG = Total Vistis (Indian)
- ;
- ;APCL5 = Grand Total (All Visits)
- ;
- ;APCL1O = New Patients 1st Visit (Non-Indian)
- ;APCL2O = Est Patients 1st Visit (Non-Indian)
- ;APCL3O = Total 1st Visits (Non-Indian)
- ;APCL4O = Additional Visits (Non-Indian)
- ;APCLGO = Total Visits (Non-Indian)
- ;
- ;IHS/CMI/LAB - added comment lines below
- ;APCL1N = New Patients 1st Visit (tribe 970)
- ;APCL2N = Est Patients 1st Visit (tribe 970)
- ;APCL3N = Total 1st Visits (tribe 970)
- ;APCL4N = Additional Visits (tribe 970)
- ;APCLGN = Total Visits (tribe 970)
- ;
- START ;
- S APCLBT=$H,APCLJOB=$J,APCL1=0,APCL2=0,APCL3=0,APCL4=0,APCL5=0,APCL1O=0,APCL2O=0,APCL3O=0,APCL4O=0,APCLG=0,APCLGO=0,(APCL1N,APCL2N,APCL3N,APCL4N,APCLGN)=0 ;IHS/CMI/LAB - added new vars to list
- S APCLSDD=$$FMADD^XLFDT(APCLBD,-1),APCLBDD=$$FMTE^XLFDT($E(APCLBD,1,3)_"0101")
- K ^XTMP("APCLCV",APCLJOB,APCLBT)
- D XTMP^APCLOSUT("APCLCV","PCC CALENDAR YR 1ST VISIT RPT")
- V ; Run by visit date
- S APCLSD=APCLSD_".9999" F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED) D V1
- ;
- XIT ;
- D EOJ
- S APCLET=$H
- Q
- V1 ;
- S APCLVIEN="" F S APCLVIEN=$O(^AUPNVSIT("B",APCLSD,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN I $D(^AUPNVSIT(APCLVIEN,0)) S APCLVREC=^(0) D PROC
- Q
- PROC ;
- Q:'$P(APCLVREC,U,9)
- Q:$P(APCLVREC,U,11)
- Q:"ETC"[$P(APCLVREC,U,7)
- Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))
- I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
- S APCLCLIN=$P(APCLVREC,U,8)
- I APCLCLIN]"",$D(APCLCLNT),'$D(APCLCLNT(APCLCLIN)) Q
- I $D(APCLCLNT),APCLCLIN="" Q
- ;I APCLCL]"",APCLCL'=$P(APCLVREC,U,8) Q
- S DFN=$P(APCLVREC,U,5)
- Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
- Q:'$D(^AUPNVPOV("AD",APCLVIEN))
- Q:'$D(^AUPNVPRV("AD",APCLVIEN))
- ;
- GETCLASS ;
- S APCLTRIB=$$TRIBE^AUPNPAT(DFN,"C") ;IHS/CMI/LAB - get tribe code
- S APCLCLAS=$$BEN^AUPNPAT(DFN,"C")
- Q:APCLCLAS=""
- ;
- S APCL5=APCL5+1 ; Grand Total
- ;
- I $D(^XTMP("APCLCV",APCLJOB,APCLBT,"PATIENTS",DFN)) D SECONDV Q
- ;
- FIRST ;First Visit Count No patient DFN in TMP Global
- ;
- S ^XTMP("APCLCV",APCLJOB,APCLBT,"PATIENTS",DFN)=""
- ;New Patients 1st Visit
- S APCLDTE=$P(^AUPNPAT(DFN,0),U,2) ; Date Patient Established
- I APCLDTE'<APCLBD,APCLDTE'>APCLED D Q
- .I APCLTRIB=970 S APCL1N=APCL1N+1,APCL3N=APCL3N+1 Q ;tribe 970 - 1st visit IHS/CMI/LAB
- .S:APCLCLAS="01" APCL1=APCL1+1 ;Indian - 1st Visit
- .S:APCLCLAS'="01" APCL1O=APCL1O+1 ;Non-Indian-1st Visit
- .S:APCLCLAS="01" APCL3=APCL3+1 ;Indian - Total 1st Visit
- .S:APCLCLAS'="01" APCL3O=APCL3O+1 ;Non-Indian - Total 1st Visit
- .Q
- ;Established Patients 1st Visit
- I '$$VST(DFN,APCLBDD,APCLSDD,APCLLOC,.APCLCLNT) D SECONDV Q
- I APCLTRIB=970 S APCL2N=APCL2N+1,APCL3N=APCL3N+1 Q ;tribe 970 - 1st visit IHS/CMI/LAB
- S:APCLCLAS="01" APCL2=APCL2+1 ;Indian - Established Pt 1st Visit
- S:APCLCLAS'="01" APCL2O=APCL2O+1 ;Non-Indian - Est Pt 1st Visit
- S:APCLCLAS="01" APCL3=APCL3+1 ;Indian - Total Est 1st Visit
- S:APCLCLAS'="01" APCL3O=APCL3O+1 ;Non-Indian - Total Est 1st Visit
- Q
- ;
- SECONDV ;Counts for Established Patients Additional Visits for Year
- ;
- I APCLTRIB=970 S APCL4N=APCL4N+1 Q ;IHS/CMI/LAB - tribe 970 additional visits
- S:APCLCLAS="01" APCL4=APCL4+1 ;Indian-Est Pts Additional Visits
- S:APCLCLAS'="01" APCL4O=APCL4O+1 ;Non-Indian-Est Pts Additional Visits
- Q
- EOJ K APCLVLOC,APCLVREC,APCLSKIP,APCLAP,APCLDISC,APCLDPTR,APCLLOCC,APCLCLN
- K X,X1,X2
- Q
- ;
- ;
- VST(APCLCVP,APCLCVFD,APCLCVLD,APCLCVL,APCLCVC) ;return 1 if patient had a visit between APCLCVFD AND APCDCVLD, otherwise return 0
- I 'APCLCVP Q 0
- I $G(APCLCVFD)="" Q 0
- I $G(APCLCVLD)="" Q 0
- I $G(APCLCVL)="" S APCLCVL=""
- NEW X,APCL
- K APCL
- S X=APCLCVP_"^ALL VISITS;DURING "_APCLCVFD_"-"_$$FMTE^XLFDT(APCLCVLD) S E=$$START1^APCLDF(X,"APCL(")
- I '$D(APCL) Q 1
- S X=0 F S X=$O(APCL(X)) Q:X'=+X D
- .S V=$P(APCL(X),U,5)
- .I '$P(^AUPNVSIT(V,0),U,9) K APCL(X)
- .I $P(^AUPNVSIT(V,0),U,11) K APCL(X)
- .Q:'$D(^AUPNVPOV("AD",V))
- .Q:'$D(^AUPNVPRV("AD",V))
- .I APCLCVL]"",$P(^AUPNVSIT(V,0),U,6)'=APCLCVL K APCL(X)
- .I "ETC"[$P(^AUPNVSIT(V,0),U,7) K APCL(X)
- .I $D(^APCLCNTL(4,11,"B",$P(^AUPNVSIT(V,0),U,3))) K APCL(X)
- .S C=$P(^AUPNVSIT(V,0),U,8) I C]"",$O(APCLCVC(0)),'$D(APCLCVC(C)) K APCL(X)
- .I $O(APCLCVC(0)),C="" K APCL(X)
- I $O(APCL(0)) Q 0
- Q 1
- APCLCV1 ; IHS/CMI/LAB - Indian Beneficiary Calendar Year Visit Summary ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;APCL1 = New Patients 1st Visit (Indian)
- +3 ;APCL2 = Est Patients 1st Visit (Indian)
- +4 ;APCL3 = Total 1st Visits (Indian)
- +5 ;APCL4 = Additional Visits (2nd,3rd, etc.) (Indian)
- +6 ;APCLG = Total Vistis (Indian)
- +7 ;
- +8 ;APCL5 = Grand Total (All Visits)
- +9 ;
- +10 ;APCL1O = New Patients 1st Visit (Non-Indian)
- +11 ;APCL2O = Est Patients 1st Visit (Non-Indian)
- +12 ;APCL3O = Total 1st Visits (Non-Indian)
- +13 ;APCL4O = Additional Visits (Non-Indian)
- +14 ;APCLGO = Total Visits (Non-Indian)
- +15 ;
- +16 ;IHS/CMI/LAB - added comment lines below
- +17 ;APCL1N = New Patients 1st Visit (tribe 970)
- +18 ;APCL2N = Est Patients 1st Visit (tribe 970)
- +19 ;APCL3N = Total 1st Visits (tribe 970)
- +20 ;APCL4N = Additional Visits (tribe 970)
- +21 ;APCLGN = Total Visits (tribe 970)
- +22 ;
- START ;
- +1 ;IHS/CMI/LAB - added new vars to list
- SET APCLBT=$HOROLOG
- SET APCLJOB=$JOB
- SET APCL1=0
- SET APCL2=0
- SET APCL3=0
- SET APCL4=0
- SET APCL5=0
- SET APCL1O=0
- SET APCL2O=0
- SET APCL3O=0
- SET APCL4O=0
- SET APCLG=0
- SET APCLGO=0
- SET (APCL1N,APCL2N,APCL3N,APCL4N,APCLGN)=0
- +2 SET APCLSDD=$$FMADD^XLFDT(APCLBD,-1)
- SET APCLBDD=$$FMTE^XLFDT($EXTRACT(APCLBD,1,3)_"0101")
- +3 KILL ^XTMP("APCLCV",APCLJOB,APCLBT)
- +4 DO XTMP^APCLOSUT("APCLCV","PCC CALENDAR YR 1ST VISIT RPT")
- V ; Run by visit date
- +1 SET APCLSD=APCLSD_".9999"
- FOR
- SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
- IF APCLSD=""!((APCLSD\1)>APCLED)
- QUIT
- DO V1
- +2 ;
- XIT ;
- +1 DO EOJ
- +2 SET APCLET=$HOROLOG
- +3 QUIT
- V1 ;
- +1 SET APCLVIEN=""
- FOR
- SET APCLVIEN=$ORDER(^AUPNVSIT("B",APCLSD,APCLVIEN))
- IF APCLVIEN'=+APCLVIEN
- QUIT
- IF $DATA(^AUPNVSIT(APCLVIEN,0))
- SET APCLVREC=^(0)
- DO PROC
- +2 QUIT
- PROC ;
- +1 IF '$PIECE(APCLVREC,U,9)
- QUIT
- +2 IF $PIECE(APCLVREC,U,11)
- QUIT
- +3 IF "ETC"[$PIECE(APCLVREC,U,7)
- QUIT
- +4 IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))
- QUIT
- +5 IF APCLLOC]""
- IF APCLLOC'=$PIECE(APCLVREC,U,6)
- QUIT
- +6 SET APCLCLIN=$PIECE(APCLVREC,U,8)
- +7 IF APCLCLIN]""
- IF $DATA(APCLCLNT)
- IF '$DATA(APCLCLNT(APCLCLIN))
- QUIT
- +8 IF $DATA(APCLCLNT)
- IF APCLCLIN=""
- QUIT
- +9 ;I APCLCL]"",APCLCL'=$P(APCLVREC,U,8) Q
- +10 SET DFN=$PIECE(APCLVREC,U,5)
- +11 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
- QUIT
- +12 IF '$DATA(^AUPNVPOV("AD",APCLVIEN))
- QUIT
- +13 IF '$DATA(^AUPNVPRV("AD",APCLVIEN))
- QUIT
- +14 ;
- GETCLASS ;
- +1 ;IHS/CMI/LAB - get tribe code
- SET APCLTRIB=$$TRIBE^AUPNPAT(DFN,"C")
- +2 SET APCLCLAS=$$BEN^AUPNPAT(DFN,"C")
- +3 IF APCLCLAS=""
- QUIT
- +4 ;
- +5 ; Grand Total
- SET APCL5=APCL5+1
- +6 ;
- +7 IF $DATA(^XTMP("APCLCV",APCLJOB,APCLBT,"PATIENTS",DFN))
- DO SECONDV
- QUIT
- +8 ;
- FIRST ;First Visit Count No patient DFN in TMP Global
- +1 ;
- +2 SET ^XTMP("APCLCV",APCLJOB,APCLBT,"PATIENTS",DFN)=""
- +3 ;New Patients 1st Visit
- +4 ; Date Patient Established
- SET APCLDTE=$PIECE(^AUPNPAT(DFN,0),U,2)
- +5 IF APCLDTE'<APCLBD
- IF APCLDTE'>APCLED
- Begin DoDot:1
- +6 ;tribe 970 - 1st visit IHS/CMI/LAB
- IF APCLTRIB=970
- SET APCL1N=APCL1N+1
- SET APCL3N=APCL3N+1
- QUIT
- +7 ;Indian - 1st Visit
- IF APCLCLAS="01"
- SET APCL1=APCL1+1
- +8 ;Non-Indian-1st Visit
- IF APCLCLAS'="01"
- SET APCL1O=APCL1O+1
- +9 ;Indian - Total 1st Visit
- IF APCLCLAS="01"
- SET APCL3=APCL3+1
- +10 ;Non-Indian - Total 1st Visit
- IF APCLCLAS'="01"
- SET APCL3O=APCL3O+1
- +11 QUIT
- End DoDot:1
- QUIT
- +12 ;Established Patients 1st Visit
- +13 IF '$$VST(DFN,APCLBDD,APCLSDD,APCLLOC,.APCLCLNT)
- DO SECONDV
- QUIT
- +14 ;tribe 970 - 1st visit IHS/CMI/LAB
- IF APCLTRIB=970
- SET APCL2N=APCL2N+1
- SET APCL3N=APCL3N+1
- QUIT
- +15 ;Indian - Established Pt 1st Visit
- IF APCLCLAS="01"
- SET APCL2=APCL2+1
- +16 ;Non-Indian - Est Pt 1st Visit
- IF APCLCLAS'="01"
- SET APCL2O=APCL2O+1
- +17 ;Indian - Total Est 1st Visit
- IF APCLCLAS="01"
- SET APCL3=APCL3+1
- +18 ;Non-Indian - Total Est 1st Visit
- IF APCLCLAS'="01"
- SET APCL3O=APCL3O+1
- +19 QUIT
- +20 ;
- SECONDV ;Counts for Established Patients Additional Visits for Year
- +1 ;
- +2 ;IHS/CMI/LAB - tribe 970 additional visits
- IF APCLTRIB=970
- SET APCL4N=APCL4N+1
- QUIT
- +3 ;Indian-Est Pts Additional Visits
- IF APCLCLAS="01"
- SET APCL4=APCL4+1
- +4 ;Non-Indian-Est Pts Additional Visits
- IF APCLCLAS'="01"
- SET APCL4O=APCL4O+1
- +5 QUIT
- EOJ KILL APCLVLOC,APCLVREC,APCLSKIP,APCLAP,APCLDISC,APCLDPTR,APCLLOCC,APCLCLN
- +1 KILL X,X1,X2
- +2 QUIT
- +3 ;
- +4 ;
- VST(APCLCVP,APCLCVFD,APCLCVLD,APCLCVL,APCLCVC) ;return 1 if patient had a visit between APCLCVFD AND APCDCVLD, otherwise return 0
- +1 IF 'APCLCVP
- QUIT 0
- +2 IF $GET(APCLCVFD)=""
- QUIT 0
- +3 IF $GET(APCLCVLD)=""
- QUIT 0
- +4 IF $GET(APCLCVL)=""
- SET APCLCVL=""
- +5 NEW X,APCL
- +6 KILL APCL
- +7 SET X=APCLCVP_"^ALL VISITS;DURING "_APCLCVFD_"-"_$$FMTE^XLFDT(APCLCVLD)
- SET E=$$START1^APCLDF(X,"APCL(")
- +8 IF '$DATA(APCL)
- QUIT 1
- +9 SET X=0
- FOR
- SET X=$ORDER(APCL(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +10 SET V=$PIECE(APCL(X),U,5)
- +11 IF '$PIECE(^AUPNVSIT(V,0),U,9)
- KILL APCL(X)
- +12 IF $PIECE(^AUPNVSIT(V,0),U,11)
- KILL APCL(X)
- +13 IF '$DATA(^AUPNVPOV("AD",V))
- QUIT
- +14 IF '$DATA(^AUPNVPRV("AD",V))
- QUIT
- +15 IF APCLCVL]""
- IF $PIECE(^AUPNVSIT(V,0),U,6)'=APCLCVL
- KILL APCL(X)
- +16 IF "ETC"[$PIECE(^AUPNVSIT(V,0),U,7)
- KILL APCL(X)
- +17 IF $DATA(^APCLCNTL(4,11,"B",$PIECE(^AUPNVSIT(V,0),U,3)))
- KILL APCL(X)
- +18 SET C=$PIECE(^AUPNVSIT(V,0),U,8)
- IF C]""
- IF $ORDER(APCLCVC(0))
- IF '$DATA(APCLCVC(C))
- KILL APCL(X)
- +19 IF $ORDER(APCLCVC(0))
- IF C=""
- KILL APCL(X)
- End DoDot:1
- +20 IF $ORDER(APCL(0))
- QUIT 0
- +21 QUIT 1
