APCLVLP1 ; IHS/CMI/LAB - CONT OF APCLVLP ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
COVPAGE ;EP
;W:$D(IOF) @IOF
W !?20,"PCC MANAGEMENT REPORTS ",$S(APCLPTVS="P":"PATIENT",1:"VISIT")," ",$S(APCLCTYP="D":"LISTING",1:"COUNT")
W !?34,"SUMMARY PAGE"
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U),!
SHOW ;
W !,$S(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
W:APCLTYPE["V" !?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD
I APCLTYPE="VP"!(APCLTYPE="VV")!(APCLTYPE="PS") W !!?6,"Search Template used: ",$P(^DIBT(APCLSEAT,0),U),!
I APCLTYPE="PR"!(APCLTYPE="VR") W !!?6,"CMS Register: ",$P(^ACM(41.1,APCLCMSR,0),U) I $D(APCLCMSS) W " Status: ",$O(APCLCMSS(""))
I '$D(^APCLVRPT(APCLRPT,11)) G SHOWP
S APCLI=0 F S APCLI=$O(^APCLVRPT(APCLRPT,11,APCLI)) Q:APCLI'=+APCLI D
.I $Y>(IOSL-5) D PAUSE^APCLVL01 W @IOF
.W !?6,$P(^APCLVSTS(APCLI,0),U),": "
.K APCLQ S APCLY="",C=0 K APCLQ F S APCLY=$O(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY)) S C=C+1 W:C'=1&(APCLY'="") " ; " Q:APCLY=""!($D(APCLQ)) S X=APCLY X:$D(^APCLVSTS(APCLI,2)) ^(2) W X
K APCLQ
SHOWP ;
W !!,"REPORT/OUTPUT TYPE",!
I APCLCTYP="F" D D PAUSE^APCLVL01 W @IOF Q
.W ?6,"A File of records called ",APCLOUTF," will be created."
.W !?6,"Total number of visits counted is ",APCLRCNT,"."
I APCLCTYP="T" D COUNT Q
I APCLCTYP="C"!(APCLCTYP="P") W !,?6,"SEARCH TEMPLATE Created: "_$P(^DIBT(APCLSTMP,0),U),!
I APCLCTYP="C"&(APCLPTVS="P") D COUNT D SETRECS^APCLSTMP Q
I APCLCTYP="P" D COUNT D SETRECS^APCLSTMP Q
I APCLCTYP="C"&(APCLPTVS="V") D COUNT D SETRECS^APCLSTMV Q
I APCLCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^APCLVL01 W @IOF
.W ?6,"Report will contain sub-totals by ",$P(^APCLVSTS(APCLSORT,0),U)," and ",!?6,"total counts."
.I '$D(^XTMP("APCLVL",APCLJOB,APCLBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^APCLVL01 W:$D(IOF) @IOF
.Q
I APCLCTYP'="D",APCLCTYP'="L" D PAUSE^APCLVL01 W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^APCLVL01 W @IOF
I APCLCTYP="D" W ?6,"Detailed Listing containing"
I APCLCTYP="L" D
.W !?5,"PLEASE NOTE: The first column of the delimited output will always"
.W !?5," be the patient internal entry number which uniquely"
.W !?5," identifies the patient. If this is a VISIT general"
.W !?5," retrieval the second column will always be the visit"
.W !?5," internal entry number which uniquely identifies the visit.",!
.W ?6,"A File of records called ",APCLDELF," will be created."
I APCLCTYP="L" W !?6,"Delimited output file will contain:"
I '$D(^APCLVRPT(APCLRPT,12)) G PAUSE
S APCLI=0 F S APCLI=$O(^APCLVRPT(APCLRPT,12,APCLI)) Q:APCLI'=+APCLI S APCLCRIT=$P(^APCLVRPT(APCLRPT,12,APCLI,0),U) D
.I $Y>(IOSL-4) D PAUSE^APCLVL01 W:$D(IOF) @IOF
.W !?6,$P(^APCLVSTS(APCLCRIT,0),U) I APCLCTYP="D" W " (" S X=$O(^APCLVRPT(APCLRPT,12,"B",APCLCRIT,"")) W $P(^APCLVRPT(APCLRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^APCLVL01 W:$D(IOF) @IOF
I APCLCTYP="D" W !?10," TOTAL column width: ",APCLTCW
Q:'$G(APCLSORT)
I $Y>(IOSL-4) D PAUSE^APCLVL01 W:$D(IOF) @IOF
W !!,$S(APCLPTVS="V":"Visits",1:"Patients")," will be SORTED by: ",$P(^APCLVSTS(APCLSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^APCLVL01 W:$D(IOF) @IOF
I $G(APCLSPAG) W !?6,"Each ",$P(^APCLVSTS(APCLSORT,0),U)," will be on a separate page.",!
I '$D(^XTMP("APCLVL",APCLJOB,APCLBTH)) W !!,"NO DATA TO REPORT.",!
I APCLCTYP="L" D
.I $D(APCLRCNT) W !!!,"Total ",$S(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLRCNT
.I $G(APCLPTVS)="V" W !,"Total Patients: ",APCLPTCT
PAUSE D PAUSE^APCLVL01 W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^APCLVL01 W:$D(IOF) @IOF
W ?6,"Totals Displayed"
I '$D(^XTMP("APCLVL",APCLJOB,APCLBTH)) W !!!,"NO DATA TO REPORT.",!
W:$D(APCLRCNT) !!!?6,"Total COUNT of ",$S(APCLPTVS="P":"Patients",1:"Visits"),": ",?34,APCLRCNT
W:APCLPTVS="V" !?6,"Total COUNT of Patients: ",?34,APCLPTCT
Q
WP ;EP - Entry point to print wp fields pass node in APCLNODE
;PASS FILE IN APCLFILE, ENTRY IN APCLDA
K ^UTILITY($J,"W")
S APCLRLX=0
S APCLG1=^DIC(APCLFILE,0,"GL"),APCLG=APCLG1_APCLDA_","_APCLNODE_",APCLRLX)",APCLGR=APCLG1_APCLDA_","_APCLNODE_",APCLRLX"
S DIWL=1,DIWR=$P(^APCLVRPT(APCLRPT,12,APCLI,0),U,2) F S APCLRLX=$O(@APCLG) Q:APCLRLX'=+APCLRLX D
.S Y=APCLGR_",0)" S X=@Y D ^DIWP
.Q
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S APCLPCNT=APCLPCNT+1,APCLPRNM(APCLPCNT)=^UTILITY($J,"W",DIWL,Z,0)
S APCLPCNT=APCLPCNT+1
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),APCLNODE,APCLFILE,APCLDA,APCLG1,APCLGR,APCLRLX
Q
APCLVLP1 ; IHS/CMI/LAB - CONT OF APCLVLP ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
COVPAGE ;EP
+1 ;W:$D(IOF) @IOF
+2 WRITE !?20,"PCC MANAGEMENT REPORTS ",$SELECT(APCLPTVS="P":"PATIENT",1:"VISIT")," ",$SELECT(APCLCTYP="D":"LISTING",1:"COUNT")
+3 WRITE !?34,"SUMMARY PAGE"
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U),!
SHOW ;
+1 WRITE !,$SELECT(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
+2 IF APCLTYPE["V"
WRITE !?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD
+3 IF APCLTYPE="VP"!(APCLTYPE="VV")!(APCLTYPE="PS")
WRITE !!?6,"Search Template used: ",$PIECE(^DIBT(APCLSEAT,0),U),!
+4 IF APCLTYPE="PR"!(APCLTYPE="VR")
WRITE !!?6,"CMS Register: ",$PIECE(^ACM(41.1,APCLCMSR,0),U)
IF $DATA(APCLCMSS)
WRITE " Status: ",$ORDER(APCLCMSS(""))
+5 IF '$DATA(^APCLVRPT(APCLRPT,11))
GOTO SHOWP
+6 SET APCLI=0
FOR
SET APCLI=$ORDER(^APCLVRPT(APCLRPT,11,APCLI))
IF APCLI'=+APCLI
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-5)
DO PAUSE^APCLVL01
WRITE @IOF
+8 WRITE !?6,$PIECE(^APCLVSTS(APCLI,0),U),": "
+9 KILL APCLQ
SET APCLY=""
SET C=0
KILL APCLQ
FOR
SET APCLY=$ORDER(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY))
SET C=C+1
IF C'=1&(APCLY'="")
WRITE " ; "
IF APCLY=""!($DATA(APCLQ))
QUIT
SET X=APCLY
IF $DATA(^APCLVSTS(APCLI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+10 KILL APCLQ
SHOWP ;
+1 WRITE !!,"REPORT/OUTPUT TYPE",!
+2 IF APCLCTYP="F"
Begin DoDot:1
+3 WRITE ?6,"A File of records called ",APCLOUTF," will be created."
+4 WRITE !?6,"Total number of visits counted is ",APCLRCNT,"."
End DoDot:1
DO PAUSE^APCLVL01
WRITE @IOF
QUIT
+5 IF APCLCTYP="T"
DO COUNT
QUIT
+6 IF APCLCTYP="C"!(APCLCTYP="P")
WRITE !,?6,"SEARCH TEMPLATE Created: "_$PIECE(^DIBT(APCLSTMP,0),U),!
+7 IF APCLCTYP="C"&(APCLPTVS="P")
DO COUNT
DO SETRECS^APCLSTMP
QUIT
+8 IF APCLCTYP="P"
DO COUNT
DO SETRECS^APCLSTMP
QUIT
+9 IF APCLCTYP="C"&(APCLPTVS="V")
DO COUNT
DO SETRECS^APCLSTMV
QUIT
+10 IF APCLCTYP="S"
Begin DoDot:1
+11 IF $Y>(IOSL-6)
DO PAUSE^APCLVL01
WRITE @IOF
+12 WRITE ?6,"Report will contain sub-totals by ",$PIECE(^APCLVSTS(APCLSORT,0),U)," and ",!?6,"total counts."
+13 IF '$DATA(^XTMP("APCLVL",APCLJOB,APCLBTH))
WRITE !!,"NO DATA TO REPORT.",!
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+14 QUIT
End DoDot:1
IF 1
+15 IF APCLCTYP'="D"
IF APCLCTYP'="L"
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
QUIT
+16 IF $Y>(IOSL-4)
DO PAUSE^APCLVL01
WRITE @IOF
+17 IF APCLCTYP="D"
WRITE ?6,"Detailed Listing containing"
+18 IF APCLCTYP="L"
Begin DoDot:1
+19 WRITE !?5,"PLEASE NOTE: The first column of the delimited output will always"
+20 WRITE !?5," be the patient internal entry number which uniquely"
+21 WRITE !?5," identifies the patient. If this is a VISIT general"
+22 WRITE !?5," retrieval the second column will always be the visit"
+23 WRITE !?5," internal entry number which uniquely identifies the visit.",!
+24 WRITE ?6,"A File of records called ",APCLDELF," will be created."
End DoDot:1
+25 IF APCLCTYP="L"
WRITE !?6,"Delimited output file will contain:"
+26 IF '$DATA(^APCLVRPT(APCLRPT,12))
GOTO PAUSE
+27 SET APCLI=0
FOR
SET APCLI=$ORDER(^APCLVRPT(APCLRPT,12,APCLI))
IF APCLI'=+APCLI
QUIT
SET APCLCRIT=$PIECE(^APCLVRPT(APCLRPT,12,APCLI,0),U)
Begin DoDot:1
+28 IF $Y>(IOSL-4)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+29 WRITE !?6,$PIECE(^APCLVSTS(APCLCRIT,0),U)
IF APCLCTYP="D"
WRITE " ("
SET X=$ORDER(^APCLVRPT(APCLRPT,12,"B",APCLCRIT,""))
WRITE $PIECE(^APCLVRPT(APCLRPT,12,X,0),U,2),")"
End DoDot:1
+30 IF $Y>(IOSL-4)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+31 IF APCLCTYP="D"
WRITE !?10," TOTAL column width: ",APCLTCW
+32 IF '$GET(APCLSORT)
QUIT
+33 IF $Y>(IOSL-4)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+34 WRITE !!,$SELECT(APCLPTVS="V":"Visits",1:"Patients")," will be SORTED by: ",$PIECE(^APCLVSTS(APCLSORT,0),U),!
+35 IF $Y>(IOSL-4)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+36 IF $GET(APCLSPAG)
WRITE !?6,"Each ",$PIECE(^APCLVSTS(APCLSORT,0),U)," will be on a separate page.",!
+37 IF '$DATA(^XTMP("APCLVL",APCLJOB,APCLBTH))
WRITE !!,"NO DATA TO REPORT.",!
+38 IF APCLCTYP="L"
Begin DoDot:1
+39 IF $DATA(APCLRCNT)
WRITE !!!,"Total ",$SELECT(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLRCNT
+40 IF $GET(APCLPTVS)="V"
WRITE !,"Total Patients: ",APCLPTCT
End DoDot:1
PAUSE DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+1 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+2 WRITE ?6,"Totals Displayed"
+3 IF '$DATA(^XTMP("APCLVL",APCLJOB,APCLBTH))
WRITE !!!,"NO DATA TO REPORT.",!
+4 IF $DATA(APCLRCNT)
WRITE !!!?6,"Total COUNT of ",$SELECT(APCLPTVS="P":"Patients",1:"Visits"),": ",?34,APCLRCNT
+5 IF APCLPTVS="V"
WRITE !?6,"Total COUNT of Patients: ",?34,APCLPTCT
+6 QUIT
WP ;EP - Entry point to print wp fields pass node in APCLNODE
+1 ;PASS FILE IN APCLFILE, ENTRY IN APCLDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET APCLRLX=0
+4 SET APCLG1=^DIC(APCLFILE,0,"GL")
SET APCLG=APCLG1_APCLDA_","_APCLNODE_",APCLRLX)"
SET APCLGR=APCLG1_APCLDA_","_APCLNODE_",APCLRLX"
+5 SET DIWL=1
SET DIWR=$PIECE(^APCLVRPT(APCLRPT,12,APCLI,0),U,2)
FOR
SET APCLRLX=$ORDER(@APCLG)
IF APCLRLX'=+APCLRLX
QUIT
Begin DoDot:1
+6 SET Y=APCLGR_",0)"
SET X=@Y
DO ^DIWP
+7 QUIT
End DoDot:1
+8 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET APCLPCNT=APCLPCNT+1
SET APCLPRNM(APCLPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+9 SET APCLPCNT=APCLPCNT+1
+10 KILL DIWL,DIWR,DIWF,Z
+11 KILL ^UTILITY($JOB,"W"),APCLNODE,APCLFILE,APCLDA,APCLG1,APCLGR,APCLRLX
+12 QUIT
