- 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
