SCRPW301 ; BPFO/JRC - Performance Monitor Detailed Report ; 2/3/04 7:33am
;;5.3;SCHEDULING;**292,335,1015**;AUG 13, 1993;Build 21
;
EN ;Main entry point for generation of local detailed report
;Declare variable(s) and arrays
N SCRNARR,SORTARR
S SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
S SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
K @SCRNARR,@SORTARR
;Get time limit
I '$$TLMT^SCRPW302(SCRNARR) D EX1 Q
;Get date frame
I '$$DATE^SCRPW302("","",SCRNARR) D EX1 Q
;Get division (one/many/all)
I '$$DIV^SCRPW302(SCRNARR) D EX1 Q
;Get provider (one/many/all)
I '$$PROV^SCRPW302(SCRNARR) D EX1 Q
;Get stop code (one/man/all)
I '$$DSS^SCRPW303(SCRNARR) D EX1 Q
;Include scanned notes
I '$$SCAN^SCRPW302(SCRNARR) D EX1 Q
;Get primary & secondary sort
I '$$SORT^SCRPW303(SORTARR) D EX1 Q
;Queue report
W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
N ZTDESC,ZTIO,ZTSAVE,TMP
S ZTIO=""
S ZTDESC="Performance Monitor Detailed Report"
S ZTSAVE("SCRNARR")=""
S TMP=$$OREF^DILF(SCRNARR)
S ZTSAVE(TMP)=""
I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
S ZTSAVE("SORTARR")=""
S TMP=$$OREF^DILF(SORTARR)
S ZTSAVE(TMP)=""
I $D(@SORTARR)#2 S ZTSAVE(SORTARR)=""
D EN^XUTMDEVQ("EN1^SCRPW301",ZTDESC,.ZTSAVE)
D EX1
Q
;
EN1 ;Tasked entry point
;Input : SCRNARR - Screen array
; SORTARR - Sort array
;Output : None
;
;Declare variables
N OUTARR,PAGENUM,ENODE,DFN,TMP
N SUB1,SUB2,PTRENC,DIV,PROV,TNODE,STOP
S OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
S STOP=0
K @OUTARR
;Get data
D GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
;Print summary page
S PAGENUM=1
D SUMMARY,WAIT I STOP D EXIT Q
;Print detailed report
I '$D(@OUTARR) D EXIT Q
;Loop through data
S STOP=0
S SUB1="" F S SUB1=$O(@OUTARR@("DETAIL",SUB1)) Q:SUB1="" D Q:STOP
.D PRTHEAD
.S SUB2="" F S SUB2=$O(@OUTARR@("DETAIL",SUB1,SUB2)) Q:SUB2="" D Q:STOP
..S DFN=0 F S DFN=+$O(@OUTARR@("DETAIL",SUB1,SUB2,DFN)) Q:'DFN D Q:STOP
...S PTRENC=0 F S PTRENC=+$O(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC)) Q:'PTRENC D Q:STOP
....S INFO=$G(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC))
....D PRTDTL
....I $Y>(IOSL-5) D WAIT Q:STOP D PRTHEAD
....Q
...Q
..Q
.Q:STOP
.D SUB1SUM,WAIT
.Q
;Clean up and quit
D EXIT
Q
;
SUMMARY ;Summary Page
;Input : SCRNARR - Screen array
; OUTARR - Data array
; PAGENUM - Page number
;Output : None
; PAGENUM is incremented by 1
;
N DIV,PROV,DSS,INFO,PS
I $E(IOST)="C" W @IOF
W !,"Performance Monitor Detailed Report",?120,"Page: ",PAGENUM
W !!,"Run Date: ",$$HTE^XLFDT($H)
W !!,"Encounter Date Range: ",?15,$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,1))
W " to ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,2))
W !!,"Time limit for acceptable signatures: ",@SCRNARR@("TLMT")
W !!,"Division(s): "
I @SCRNARR@("DIVISION")=0 D
.S PS=0
.S DIV=0 F S DIV=$O(@SCRNARR@("DIVISION",DIV)) Q:'DIV D
..S INFO=@SCRNARR@("DIVISION",DIV)
..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
..I PS W " / "
..W INFO
..S PS=1
.Q
I @SCRNARR@("DIVISION")=1 W "All"
W !!,"Provider(s): "
I @SCRNARR@("PROVIDERS")=0 D
.S PS=0
.S PROV=0 F S PROV=$O(@SCRNARR@("PROVIDERS",PROV)) Q:'PROV D
..S INFO=@SCRNARR@("PROVIDERS",PROV)
..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
..I PS W " / "
..W INFO
..S PS=1
.Q
I @SCRNARR@("PROVIDERS")=1 W "All"
W !!,"DSS ID(s) : "
I @SCRNARR@("DSS")=0 D
.I @SCRNARR@("DSS-NTNL") W "All stop codes & credit pairs in national cohort" Q
.S PS=0
.S DSS=0 F S DSS=$O(@SCRNARR@("DSS",DSS)) Q:'DSS D
..S INFO=@SCRNARR@("DSS",DSS)
..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
..I PS W " / "
..W INFO
..S PS=1
I @SCRNARR@("DSS")=1 W "All"
W !!,"Count encounters with scanned notes: ",$S(@SCRNARR@("SCANNED"):"YES",1:"NO")
I '$D(@OUTARR) D Q
.W !
.W !,"*********************************************"
.W !,"* NOTHING TO REPORT FOR SELECTED CRITERIA *"
.W !,"*********************************************"
S INFO=$$SITE^VASITE()
W !!,"Total for facility ",$P(INFO,"^",2)," (",$P(INFO,"^",3),")"
I $$S^%ZTLOAD() W !! Q
S INFO=$G(@OUTARR@("SUMMARY"))
D PRTSUMS
Q
;
PRTSUMS ;Print summaries
;Input : INFO - Summary information to print
; SCRNARR - Screen array
;Output : None
;
N VAL
W !,"Encounters (denominator): ",+$P(INFO,U,1)
W ?34,"Compliant Notes (numerator): ",+$P(INFO,U,2)
W ?69,"Compliance Rate: "
S VAL=0 I +$P(INFO,U,1)&($P(INFO,U,1)-$P(INFO,U,7))>0 S VAL=100*($P(INFO,U,2)/($P(INFO,U,1)-$P(INFO,U,7)))
W $TR($J(VAL,3,0)," ")_" %"
W !,?5,"Encounter Providers: ",+$P(INFO,U,4)
W ?34,"DSS IDs: ",+$P(INFO,U,5),?53,"Ave Time: "
S VAL=0 I +$P(INFO,U,8) S VAL=$P(INFO,U,6)/$P(INFO,U,8)
W $TR($J(VAL,3,0)," ")
I $G(@SCRNARR@("SCANNED")) W ?71,"Scanned Notes: ",+$P(INFO,U,7)
Q
;
WAIT ;End of page logic
;Input : None
;Output : STOP - Flag indicating if printing should continue
; 1 = Stop 0 = Continue
;
S STOP=0
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
.F Q:$Y>(IOSL-3) W !
.N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
.S DIR(0)="E"
.D ^DIR
.S STOP=$S(Y'=1:1,1:0)
;Background task - check TaskMan
S STOP=$$S^%ZTLOAD()
I STOP D
.W !,"*********************************************"
.W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
.W !,"*********************************************"
Q
;
PRTHEAD ;Report Heading
;Input : SORTARR - Sort array
; PAGENUM - Page number
; SUB1 - Primary sort value
;Output : None
; PAGENUM is incremented by 1
;
N SORT,SORTTEXT,DASH,TYPE
S SORT=$G(@SORTARR)
S SORTTEXT=$G(@SORTARR@("TEXT"))
S PAGENUM=PAGENUM+1
S $P(DASH,"-",IOM)="-"
W @IOF
W !,"Performance indicator detailed report",?120,"Page: ",PAGENUM
W !!,"Report for ",$P(SORTTEXT,U,1)," "
S TYPE=$P(SORT,U,1) D
.I TYPE=1 W $P(SUB1,U,1)," (",$P(SUB1,U,2),")" Q
.I TYPE=5 W $$FMTE^XLFDT(SUB1,"D") Q
.W SUB1
W " sorted by ",$P(SORTTEXT,U,2)
W !!,"Encounter",?40,"Primary Encounter",?62,"DSS"
W ?89,"Acceptable Provider",?112,"Date",?122,"Time"
W !,"Date",?11,"Patient Name",?34,"SSN",?40,"Provider",?62,"ID"
W ?67,"Clinic Name",?89,"Signing Progress Note",?112,"Signed"
W ?122,"Span"
W !,$E(DASH,1,9),?11,$E(DASH,1,21),?34,$E(DASH,1,4),?40,$E(DASH,1,20)
W ?62,$E(DASH,1,3),?67,$E(DASH,1,20),?89,$E(DASH,1,21),?112,$E(DASH,1,8)
W ?122,$E(DASH,1,5)
Q
;
PRTDTL ;Print detail line
;Input : INFO - Detail information to print
; DFN - Pointer to Patient
; PTRENC - Pointer to Outpatient Encounter
;Output : None
;
N PROV,ENODE,VAL,VADM,VAERR,VA
D DEM^VADPT
S PROV=$$ENCPROV^SDPMUT2(PTRENC)
S ENODE=$G(^SCE(PTRENC,0))
S VAL=$$FMTE^XLFDT($P(ENODE,U,1),"2DF")
W !,$TR(VAL," ","0")
W ?11,$E(VADM(1),1,21)
W ?34,$E($P(VADM(2),U,1),6,10)
I PROV W ?40,$E($P($G(^VA(200,PROV,0)),U,1),1,20)
I 'PROV W ?40,"Provider Unknown"
S VAL=$P(ENODE,U,3)
S VAL=$P($G(^DIC(40.7,VAL,0)),U,2)
S:VAL="" VAL="???"
W ?62,VAL
S VAL=$P(ENODE,U,4)
S VAL=$P($G(^SC(VAL,0)),U,1)
S:VAL="" VAL="Clinic Unknown"
W ?67,$E(VAL,1,20)
S VAL=$P(INFO,U,1)
I VAL W ?89,$E($P($G(^VA(200,VAL,0)),U,1),1,21)
S VAL=$P(INFO,U,2)
I VAL S VAL=$$FMTE^XLFDT(VAL,"2DF") W ?112,$TR(VAL," ","0")
W ?122,$P(INFO,U,3)
Q
;
SUB1SUM ;Summary for primary sort
;Input : SORTARR - Sort array
; OUTARR - Data array
; SUB1 - Primary sort value (1st subscript in OUTARR)
;Output : None
;
N SORT,SORTTEXT,TYPE,INFO
I $Y>(IOSL+6) D WAIT Q:STOP D PRTHEAD
S SORT=$G(@SORTARR)
S SORTTEXT=$G(@SORTARR@("TEXT"))
S INFO=$G(@OUTARR@("SUBTOTAL",SUB1))
W !!,"Total for ",$P(SORTTEXT,U,1)," "
S TYPE=$P(SORT,U,1) D
.I TYPE=1 W $P(SUB1,U,1)," (",$P(SUB1,U,2),")" Q
.I TYPE=5 W $$FMTE^XLFDT(SUB1,"D") Q
.W SUB1
D PRTSUMS
Q
;
EXIT ;Kill temporary arrays
K @OUTARR
EX1 K @SCRNARR,@SORTARR
Q
SCRPW301 ; BPFO/JRC - Performance Monitor Detailed Report ; 2/3/04 7:33am
+1 ;;5.3;SCHEDULING;**292,335,1015**;AUG 13, 1993;Build 21
+2 ;
EN ;Main entry point for generation of local detailed report
+1 ;Declare variable(s) and arrays
+2 NEW SCRNARR,SORTARR
+3 SET SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
+4 SET SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
+5 KILL @SCRNARR,@SORTARR
+6 ;Get time limit
+7 IF '$$TLMT^SCRPW302(SCRNARR)
DO EX1
QUIT
+8 ;Get date frame
+9 IF '$$DATE^SCRPW302("","",SCRNARR)
DO EX1
QUIT
+10 ;Get division (one/many/all)
+11 IF '$$DIV^SCRPW302(SCRNARR)
DO EX1
QUIT
+12 ;Get provider (one/many/all)
+13 IF '$$PROV^SCRPW302(SCRNARR)
DO EX1
QUIT
+14 ;Get stop code (one/man/all)
+15 IF '$$DSS^SCRPW303(SCRNARR)
DO EX1
QUIT
+16 ;Include scanned notes
+17 IF '$$SCAN^SCRPW302(SCRNARR)
DO EX1
QUIT
+18 ;Get primary & secondary sort
+19 IF '$$SORT^SCRPW303(SORTARR)
DO EX1
QUIT
+20 ;Queue report
+21 WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
+22 NEW ZTDESC,ZTIO,ZTSAVE,TMP
+23 SET ZTIO=""
+24 SET ZTDESC="Performance Monitor Detailed Report"
+25 SET ZTSAVE("SCRNARR")=""
+26 SET TMP=$$OREF^DILF(SCRNARR)
+27 SET ZTSAVE(TMP)=""
+28 IF $DATA(@SCRNARR)#2
SET ZTSAVE(SCRNARR)=""
+29 SET ZTSAVE("SORTARR")=""
+30 SET TMP=$$OREF^DILF(SORTARR)
+31 SET ZTSAVE(TMP)=""
+32 IF $DATA(@SORTARR)#2
SET ZTSAVE(SORTARR)=""
+33 DO EN^XUTMDEVQ("EN1^SCRPW301",ZTDESC,.ZTSAVE)
+34 DO EX1
+35 QUIT
+36 ;
EN1 ;Tasked entry point
+1 ;Input : SCRNARR - Screen array
+2 ; SORTARR - Sort array
+3 ;Output : None
+4 ;
+5 ;Declare variables
+6 NEW OUTARR,PAGENUM,ENODE,DFN,TMP
+7 NEW SUB1,SUB2,PTRENC,DIV,PROV,TNODE,STOP
+8 SET OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
+9 SET STOP=0
+10 KILL @OUTARR
+11 ;Get data
+12 DO GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
+13 ;Print summary page
+14 SET PAGENUM=1
+15 DO SUMMARY
DO WAIT
IF STOP
DO EXIT
QUIT
+16 ;Print detailed report
+17 IF '$DATA(@OUTARR)
DO EXIT
QUIT
+18 ;Loop through data
+19 SET STOP=0
+20 SET SUB1=""
FOR
SET SUB1=$ORDER(@OUTARR@("DETAIL",SUB1))
IF SUB1=""
QUIT
Begin DoDot:1
+21 DO PRTHEAD
+22 SET SUB2=""
FOR
SET SUB2=$ORDER(@OUTARR@("DETAIL",SUB1,SUB2))
IF SUB2=""
QUIT
Begin DoDot:2
+23 SET DFN=0
FOR
SET DFN=+$ORDER(@OUTARR@("DETAIL",SUB1,SUB2,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+24 SET PTRENC=0
FOR
SET PTRENC=+$ORDER(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC))
IF 'PTRENC
QUIT
Begin DoDot:4
+25 SET INFO=$GET(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC))
+26 DO PRTDTL
+27 IF $Y>(IOSL-5)
DO WAIT
IF STOP
QUIT
DO PRTHEAD
+28 QUIT
End DoDot:4
IF STOP
QUIT
+29 QUIT
End DoDot:3
IF STOP
QUIT
+30 QUIT
End DoDot:2
IF STOP
QUIT
+31 IF STOP
QUIT
+32 DO SUB1SUM
DO WAIT
+33 QUIT
End DoDot:1
IF STOP
QUIT
+34 ;Clean up and quit
+35 DO EXIT
+36 QUIT
+37 ;
SUMMARY ;Summary Page
+1 ;Input : SCRNARR - Screen array
+2 ; OUTARR - Data array
+3 ; PAGENUM - Page number
+4 ;Output : None
+5 ; PAGENUM is incremented by 1
+6 ;
+7 NEW DIV,PROV,DSS,INFO,PS
+8 IF $EXTRACT(IOST)="C"
WRITE @IOF
+9 WRITE !,"Performance Monitor Detailed Report",?120,"Page: ",PAGENUM
+10 WRITE !!,"Run Date: ",$$HTE^XLFDT($HOROLOG)
+11 WRITE !!,"Encounter Date Range: ",?15,$$FMTE^XLFDT($PIECE(@SCRNARR@("RANGE"),U,1))
+12 WRITE " to ",$$FMTE^XLFDT($PIECE(@SCRNARR@("RANGE"),U,2))
+13 WRITE !!,"Time limit for acceptable signatures: ",@SCRNARR@("TLMT")
+14 WRITE !!,"Division(s): "
+15 IF @SCRNARR@("DIVISION")=0
Begin DoDot:1
+16 SET PS=0
+17 SET DIV=0
FOR
SET DIV=$ORDER(@SCRNARR@("DIVISION",DIV))
IF 'DIV
QUIT
Begin DoDot:2
+18 SET INFO=@SCRNARR@("DIVISION",DIV)
+19 IF ($LENGTH(INFO)+$X+3)>(IOM-1)
WRITE !,?13,"/ "
SET PS=0
+20 IF PS
WRITE " / "
+21 WRITE INFO
+22 SET PS=1
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF @SCRNARR@("DIVISION")=1
WRITE "All"
+25 WRITE !!,"Provider(s): "
+26 IF @SCRNARR@("PROVIDERS")=0
Begin DoDot:1
+27 SET PS=0
+28 SET PROV=0
FOR
SET PROV=$ORDER(@SCRNARR@("PROVIDERS",PROV))
IF 'PROV
QUIT
Begin DoDot:2
+29 SET INFO=@SCRNARR@("PROVIDERS",PROV)
+30 IF ($LENGTH(INFO)+$X+3)>(IOM-1)
WRITE !,?13,"/ "
SET PS=0
+31 IF PS
WRITE " / "
+32 WRITE INFO
+33 SET PS=1
End DoDot:2
+34 QUIT
End DoDot:1
+35 IF @SCRNARR@("PROVIDERS")=1
WRITE "All"
+36 WRITE !!,"DSS ID(s) : "
+37 IF @SCRNARR@("DSS")=0
Begin DoDot:1
+38 IF @SCRNARR@("DSS-NTNL")
WRITE "All stop codes & credit pairs in national cohort"
QUIT
+39 SET PS=0
+40 SET DSS=0
FOR
SET DSS=$ORDER(@SCRNARR@("DSS",DSS))
IF 'DSS
QUIT
Begin DoDot:2
+41 SET INFO=@SCRNARR@("DSS",DSS)
+42 IF ($LENGTH(INFO)+$X+3)>(IOM-1)
WRITE !,?13,"/ "
SET PS=0
+43 IF PS
WRITE " / "
+44 WRITE INFO
+45 SET PS=1
End DoDot:2
End DoDot:1
+46 IF @SCRNARR@("DSS")=1
WRITE "All"
+47 WRITE !!,"Count encounters with scanned notes: ",$SELECT(@SCRNARR@("SCANNED"):"YES",1:"NO")
+48 IF '$DATA(@OUTARR)
Begin DoDot:1
+49 WRITE !
+50 WRITE !,"*********************************************"
+51 WRITE !,"* NOTHING TO REPORT FOR SELECTED CRITERIA *"
+52 WRITE !,"*********************************************"
End DoDot:1
QUIT
+53 SET INFO=$$SITE^VASITE()
+54 WRITE !!,"Total for facility ",$PIECE(INFO,"^",2)," (",$PIECE(INFO,"^",3),")"
+55 IF $$S^%ZTLOAD()
WRITE !!
QUIT
+56 SET INFO=$GET(@OUTARR@("SUMMARY"))
+57 DO PRTSUMS
+58 QUIT
+59 ;
PRTSUMS ;Print summaries
+1 ;Input : INFO - Summary information to print
+2 ; SCRNARR - Screen array
+3 ;Output : None
+4 ;
+5 NEW VAL
+6 WRITE !,"Encounters (denominator): ",+$PIECE(INFO,U,1)
+7 WRITE ?34,"Compliant Notes (numerator): ",+$PIECE(INFO,U,2)
+8 WRITE ?69,"Compliance Rate: "
+9 SET VAL=0
IF +$PIECE(INFO,U,1)&($PIECE(INFO,U,1)-$PIECE(INFO,U,7))>0
SET VAL=100*($PIECE(INFO,U,2)/($PIECE(INFO,U,1)-$PIECE(INFO,U,7)))
+10 WRITE $TRANSLATE($JUSTIFY(VAL,3,0)," ")_" %"
+11 WRITE !,?5,"Encounter Providers: ",+$PIECE(INFO,U,4)
+12 WRITE ?34,"DSS IDs: ",+$PIECE(INFO,U,5),?53,"Ave Time: "
+13 SET VAL=0
IF +$PIECE(INFO,U,8)
SET VAL=$PIECE(INFO,U,6)/$PIECE(INFO,U,8)
+14 WRITE $TRANSLATE($JUSTIFY(VAL,3,0)," ")
+15 IF $GET(@SCRNARR@("SCANNED"))
WRITE ?71,"Scanned Notes: ",+$PIECE(INFO,U,7)
+16 QUIT
+17 ;
WAIT ;End of page logic
+1 ;Input : None
+2 ;Output : STOP - Flag indicating if printing should continue
+3 ; 1 = Stop 0 = Continue
+4 ;
+5 SET STOP=0
+6 ;CRT - Prompt for continue
+7 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
Begin DoDot:1
+8 FOR
IF $Y>(IOSL-3)
QUIT
WRITE !
+9 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+13 ;Background task - check TaskMan
+14 SET STOP=$$S^%ZTLOAD()
+15 IF STOP
Begin DoDot:1
+16 WRITE !,"*********************************************"
+17 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
+18 WRITE !,"*********************************************"
End DoDot:1
+19 QUIT
+20 ;
PRTHEAD ;Report Heading
+1 ;Input : SORTARR - Sort array
+2 ; PAGENUM - Page number
+3 ; SUB1 - Primary sort value
+4 ;Output : None
+5 ; PAGENUM is incremented by 1
+6 ;
+7 NEW SORT,SORTTEXT,DASH,TYPE
+8 SET SORT=$GET(@SORTARR)
+9 SET SORTTEXT=$GET(@SORTARR@("TEXT"))
+10 SET PAGENUM=PAGENUM+1
+11 SET $PIECE(DASH,"-",IOM)="-"
+12 WRITE @IOF
+13 WRITE !,"Performance indicator detailed report",?120,"Page: ",PAGENUM
+14 WRITE !!,"Report for ",$PIECE(SORTTEXT,U,1)," "
+15 SET TYPE=$PIECE(SORT,U,1)
Begin DoDot:1
+16 IF TYPE=1
WRITE $PIECE(SUB1,U,1)," (",$PIECE(SUB1,U,2),")"
QUIT
+17 IF TYPE=5
WRITE $$FMTE^XLFDT(SUB1,"D")
QUIT
+18 WRITE SUB1
End DoDot:1
+19 WRITE " sorted by ",$PIECE(SORTTEXT,U,2)
+20 WRITE !!,"Encounter",?40,"Primary Encounter",?62,"DSS"
+21 WRITE ?89,"Acceptable Provider",?112,"Date",?122,"Time"
+22 WRITE !,"Date",?11,"Patient Name",?34,"SSN",?40,"Provider",?62,"ID"
+23 WRITE ?67,"Clinic Name",?89,"Signing Progress Note",?112,"Signed"
+24 WRITE ?122,"Span"
+25 WRITE !,$EXTRACT(DASH,1,9),?11,$EXTRACT(DASH,1,21),?34,$EXTRACT(DASH,1,4),?40,$EXTRACT(DASH,1,20)
+26 WRITE ?62,$EXTRACT(DASH,1,3),?67,$EXTRACT(DASH,1,20),?89,$EXTRACT(DASH,1,21),?112,$EXTRACT(DASH,1,8)
+27 WRITE ?122,$EXTRACT(DASH,1,5)
+28 QUIT
+29 ;
PRTDTL ;Print detail line
+1 ;Input : INFO - Detail information to print
+2 ; DFN - Pointer to Patient
+3 ; PTRENC - Pointer to Outpatient Encounter
+4 ;Output : None
+5 ;
+6 NEW PROV,ENODE,VAL,VADM,VAERR,VA
+7 DO DEM^VADPT
+8 SET PROV=$$ENCPROV^SDPMUT2(PTRENC)
+9 SET ENODE=$GET(^SCE(PTRENC,0))
+10 SET VAL=$$FMTE^XLFDT($PIECE(ENODE,U,1),"2DF")
+11 WRITE !,$TRANSLATE(VAL," ","0")
+12 WRITE ?11,$EXTRACT(VADM(1),1,21)
+13 WRITE ?34,$EXTRACT($PIECE(VADM(2),U,1),6,10)
+14 IF PROV
WRITE ?40,$EXTRACT($PIECE($GET(^VA(200,PROV,0)),U,1),1,20)
+15 IF 'PROV
WRITE ?40,"Provider Unknown"
+16 SET VAL=$PIECE(ENODE,U,3)
+17 SET VAL=$PIECE($GET(^DIC(40.7,VAL,0)),U,2)
+18 IF VAL=""
SET VAL="???"
+19 WRITE ?62,VAL
+20 SET VAL=$PIECE(ENODE,U,4)
+21 SET VAL=$PIECE($GET(^SC(VAL,0)),U,1)
+22 IF VAL=""
SET VAL="Clinic Unknown"
+23 WRITE ?67,$EXTRACT(VAL,1,20)
+24 SET VAL=$PIECE(INFO,U,1)
+25 IF VAL
WRITE ?89,$EXTRACT($PIECE($GET(^VA(200,VAL,0)),U,1),1,21)
+26 SET VAL=$PIECE(INFO,U,2)
+27 IF VAL
SET VAL=$$FMTE^XLFDT(VAL,"2DF")
WRITE ?112,$TRANSLATE(VAL," ","0")
+28 WRITE ?122,$PIECE(INFO,U,3)
+29 QUIT
+30 ;
SUB1SUM ;Summary for primary sort
+1 ;Input : SORTARR - Sort array
+2 ; OUTARR - Data array
+3 ; SUB1 - Primary sort value (1st subscript in OUTARR)
+4 ;Output : None
+5 ;
+6 NEW SORT,SORTTEXT,TYPE,INFO
+7 IF $Y>(IOSL+6)
DO WAIT
IF STOP
QUIT
DO PRTHEAD
+8 SET SORT=$GET(@SORTARR)
+9 SET SORTTEXT=$GET(@SORTARR@("TEXT"))
+10 SET INFO=$GET(@OUTARR@("SUBTOTAL",SUB1))
+11 WRITE !!,"Total for ",$PIECE(SORTTEXT,U,1)," "
+12 SET TYPE=$PIECE(SORT,U,1)
Begin DoDot:1
+13 IF TYPE=1
WRITE $PIECE(SUB1,U,1)," (",$PIECE(SUB1,U,2),")"
QUIT
+14 IF TYPE=5
WRITE $$FMTE^XLFDT(SUB1,"D")
QUIT
+15 WRITE SUB1
End DoDot:1
+16 DO PRTSUMS
+17 QUIT
+18 ;
EXIT ;Kill temporary arrays
+1 KILL @OUTARR
EX1 KILL @SCRNARR,@SORTARR
+1 QUIT
