SD53227 ;ALB/RBS - Print Encounter/Visit Date/Time 421 error ; 10/11/00 5:23pm
;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
;
;DBIA Integration Reference # 3211.
;
;This routine will print a report of Encounters with a 421 error code
;(invalid date and time) that can or cannot be cleaned up.
;
;The ^XTMP global will be used as an audit file of all encounters
;that have been fixed and retransmitted to the NPCD.
;The purge date will be 30 days from last Cleanup option run.
; ^XTMP("SD53P227",0)=STRING of 10 fields
; STRING = purge date^run date^start dt/time^stop dt/time...
; ^option run^last cleanup d/t run^DUZ of user...
; ^tot errors^tot fixed^tot searched
; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
; ^XTMP("SD53P227",3)=e-mail report sent to user
; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
Q
;*;
;
PRINT ; Print report
K @SDTEMP@(3) ;kill E-mail node
N DASH,ENCPTR,ERRPTR,GTOT,HEAD1,LINE,SDI,SDL,SDX,STR
N PAGE,SUBT1,SUBT2,TOTALS,XMITPTR,X,Y
S (ERRPTR,XMITPTR,ENCPTR,SDX,STR,X,Y)=""
S (EXIT,GTOT,PAGE,SDL,TOTALS)=0
D HEAD
;
; loop thru error and fix nodes to setup report info
F SDI=1,2 D:$O(@SDTEMP@(SDI,""))'="" Q:EXIT
.D HDR(SDI) Q:EXIT
.F S ERRPTR=$O(@SDTEMP@(SDI,ERRPTR)) Q:ERRPTR="" D Q:EXIT
..I ($$S^%ZTLOAD) S EXIT=1 Q
..S $P(TOTALS,U,SDI)=$P(TOTALS,U,SDI)+1,GTOT=GTOT+1
..F S XMITPTR=$O(@SDTEMP@(SDI,ERRPTR,XMITPTR)) Q:XMITPTR="" D Q:EXIT
...F S ENCPTR=$O(@SDTEMP@(SDI,ERRPTR,XMITPTR,ENCPTR)) Q:ENCPTR="" D Q:EXIT
....S STR=@SDTEMP@(SDI,ERRPTR,XMITPTR,ENCPTR)
....Q:$G(STR)=""
....D WRT(STR,SDI)
....Q:EXIT
.D TOTAL(SDI,TOTALS,0)
.S PAGE=0
S $P(TOTALS,U,3)=GTOT,PAGE=0
D HDR(2) Q:EXIT
D MHDR(2)
S SUBT1="GRAND TOTALS:"
W !!,SUBT1,! ;write to device
D XML(""),XML(SUBT1),XML("") ;write to E-mail
F SDI=1,2,3 D TOTAL(SDI,TOTALS,1)
S SUBT1="<End of Report>"
W !!,SUBT1,!
D XML(""),XML(SUBT1),XML(DASH)
Q
;
LINE1(STR,SDX) ;Format 1st output line
S SDX=""
D XMX(1,$E($P(STR,U,2),1,22)),XMX(25,$P(STR,U,4)),XMX(37,$E($P(STR,U,5),1,20)),XMX(60,$$DT($P(STR,U,6)))
Q
;
LINE2(STR,SDX) ; Format 2nd output line
S SDX=""
D XMX(50,"New D/T:"),XMX(60,$$DTT(STR))
Q
;
WRT(STR,SDI) ;Write to screen/device or Add to E-mail report file
S SDX=""
I CRT,($Y>(IOSL-5)) D HDR(SDI) Q:EXIT
D LINE1(STR,.SDX)
W !,SDX
D LINE2($P(STR,U,7),.SDX)
W !,SDX
Q
;
XMX(X,Y) ;Set message text value
S $E(SDX,X)=Y
Q
;
XML(X) ;Set message text line
; ^XTMP("SD53P227",3,#) = E-mail report of all records
S SDL=SDL+1
S @SDTEMP@(3,SDL)=X
Q
;
DT(SDDT) ;Format slashed date - (Original date/time with seconds)
Q $E(SDDT,4,5)_"/"_$E(SDDT,6,7)_"/"_(17+$E(SDDT))_$E(SDDT,2,3)_"@"_$P(SDDT,".",2)
;
DTT(SDDT) ;Format slashed date - (New date/time without seconds)
I $E(SDDT)'?1N Q SDDT ;error msg's will kick out
Q $E(SDDT,4,5)_"/"_$E(SDDT,6,7)_"/"_(17+$E(SDDT))_$E(SDDT,2,3)_"@"_$E($P(SDDT,".",2)_"0000",1,4)
;
HDR(SDI) ; Print header
S (SDX,X)=""
I PAGE,CRT D Q:EXIT
.S DIR(0)="E" D ^DIR K DIR
.I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) S EXIT=1 Q
.S EXIT='+$G(Y)
W @IOF
S PAGE=PAGE+1,X="Page: "_PAGE,SDX=RUNDT,$E(SDX,(80-$L(X)))=X
W TITLE,!,SDX,!,$S(SDI=1:SUBT1,1:SUBT2),!,HEAD1,!,DASH
Q
;
MHDR(SDI) ; Sets up the Mail msg header
S (SDX,X)="",X="Page: 1",SDX=RUNDT,$E(SDX,(80-$L(X)))=X
D XML(""),XML(TITLE),XML(SDX)
S SDX="",X="Summary of Encounters",$E(SDX,(80-$L(X)\2))=X
D XML(SDX),XML(DASH)
Q
;
TOTAL(SDI,TOTALS,Y) ; Print out totals
S X="Total Encounters "
S X=X_$S(SDI=1:"Unsendable:",SDI=2:"Flagged...:",SDI=3:"Searched..:",1:"")
S X=X_$J(+$P(TOTALS,U,SDI),10)
W !,X
D:Y XML(X)
Q
;
HEAD ; Setup header and sub-header lines
N X
S SDTEMP="^XTMP(""SD53P227"")",$P(DASH,"-",80)="",X=TITLE
S:SDRTYP="R" X=$P(TITLE," & Cleanup")
S TITLE="",$E(TITLE,(80-$L(X)\2))=X,X=""
S X="Date Run: "_$P($$FMTE^XLFDT(TIMESTRT),":",1,2),$E(RUNDT,(80-$L(X)\2))=X,X=""
S X="Error listing of Encounters not updated"
S $E(SUBT1,(80-$L(X)\2))=X
S X="Preview list of Encounters to be updated"
S:FIX X="Encounters Updated and Flagged for Retransmission"
S $E(SUBT2,(80-$L(X)\2))=X,X=""
;
D XMX(1,"Patient"),XMX(25,"SSN"),XMX(37,"Location"),XMX(60,"Encounter Date/Time")
S HEAD1=SDX
Q
;
NOFIND ; Nothing to report
N DASH,HEAD1,LINE,SDI,SDL,SDX,STR
N PAGE,SUBT1,SUBT2,X,Y
S (SDI,SDL,SDX,STR,SUBT1,SUBT2,X,Y)=""
S (EXIT,PAGE,SDL)=0
D HEAD,HDR(1)
K @SDTEMP@(3) ;kill E-mail node
S X="No Outpatient Encounter 421 Error records found."
W !!,X
D XML(""),XML(X),XML("")
S X="<End of Report>"
W !!,X
D XML(X),XML("")
Q
SD53227 ;ALB/RBS - Print Encounter/Visit Date/Time 421 error ; 10/11/00 5:23pm
+1 ;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
+2 ;
+3 ;DBIA Integration Reference # 3211.
+4 ;
+5 ;This routine will print a report of Encounters with a 421 error code
+6 ;(invalid date and time) that can or cannot be cleaned up.
+7 ;
+8 ;The ^XTMP global will be used as an audit file of all encounters
+9 ;that have been fixed and retransmitted to the NPCD.
+10 ;The purge date will be 30 days from last Cleanup option run.
+11 ; ^XTMP("SD53P227",0)=STRING of 10 fields
+12 ; STRING = purge date^run date^start dt/time^stop dt/time...
+13 ; ^option run^last cleanup d/t run^DUZ of user...
+14 ; ^tot errors^tot fixed^tot searched
+15 ; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
+16 ; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
+17 ; ^XTMP("SD53P227",3)=e-mail report sent to user
+18 ; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
+19 QUIT
+20 ;*;
+21 ;
PRINT ; Print report
+1 ;kill E-mail node
KILL @SDTEMP@(3)
+2 NEW DASH,ENCPTR,ERRPTR,GTOT,HEAD1,LINE,SDI,SDL,SDX,STR
+3 NEW PAGE,SUBT1,SUBT2,TOTALS,XMITPTR,X,Y
+4 SET (ERRPTR,XMITPTR,ENCPTR,SDX,STR,X,Y)=""
+5 SET (EXIT,GTOT,PAGE,SDL,TOTALS)=0
+6 DO HEAD
+7 ;
+8 ; loop thru error and fix nodes to setup report info
+9 FOR SDI=1,2
IF $ORDER(@SDTEMP@(SDI,""))'=""
Begin DoDot:1
+10 DO HDR(SDI)
IF EXIT
QUIT
+11 FOR
SET ERRPTR=$ORDER(@SDTEMP@(SDI,ERRPTR))
IF ERRPTR=""
QUIT
Begin DoDot:2
+12 IF ($$S^%ZTLOAD)
SET EXIT=1
QUIT
+13 SET $PIECE(TOTALS,U,SDI)=$PIECE(TOTALS,U,SDI)+1
SET GTOT=GTOT+1
+14 FOR
SET XMITPTR=$ORDER(@SDTEMP@(SDI,ERRPTR,XMITPTR))
IF XMITPTR=""
QUIT
Begin DoDot:3
+15 FOR
SET ENCPTR=$ORDER(@SDTEMP@(SDI,ERRPTR,XMITPTR,ENCPTR))
IF ENCPTR=""
QUIT
Begin DoDot:4
+16 SET STR=@SDTEMP@(SDI,ERRPTR,XMITPTR,ENCPTR)
+17 IF $GET(STR)=""
QUIT
+18 DO WRT(STR,SDI)
+19 IF EXIT
QUIT
End DoDot:4
IF EXIT
QUIT
End DoDot:3
IF EXIT
QUIT
End DoDot:2
IF EXIT
QUIT
+20 DO TOTAL(SDI,TOTALS,0)
+21 SET PAGE=0
End DoDot:1
IF EXIT
QUIT
+22 SET $PIECE(TOTALS,U,3)=GTOT
SET PAGE=0
+23 DO HDR(2)
IF EXIT
QUIT
+24 DO MHDR(2)
+25 SET SUBT1="GRAND TOTALS:"
+26 ;write to device
WRITE !!,SUBT1,!
+27 ;write to E-mail
DO XML("")
DO XML(SUBT1)
DO XML("")
+28 FOR SDI=1,2,3
DO TOTAL(SDI,TOTALS,1)
+29 SET SUBT1="<End of Report>"
+30 WRITE !!,SUBT1,!
+31 DO XML("")
DO XML(SUBT1)
DO XML(DASH)
+32 QUIT
+33 ;
LINE1(STR,SDX) ;Format 1st output line
+1 SET SDX=""
+2 DO XMX(1,$EXTRACT($PIECE(STR,U,2),1,22))
DO XMX(25,$PIECE(STR,U,4))
DO XMX(37,$EXTRACT($PIECE(STR,U,5),1,20))
DO XMX(60,$$DT($PIECE(STR,U,6)))
+3 QUIT
+4 ;
LINE2(STR,SDX) ; Format 2nd output line
+1 SET SDX=""
+2 DO XMX(50,"New D/T:")
DO XMX(60,$$DTT(STR))
+3 QUIT
+4 ;
WRT(STR,SDI) ;Write to screen/device or Add to E-mail report file
+1 SET SDX=""
+2 IF CRT
IF ($Y>(IOSL-5))
DO HDR(SDI)
IF EXIT
QUIT
+3 DO LINE1(STR,.SDX)
+4 WRITE !,SDX
+5 DO LINE2($PIECE(STR,U,7),.SDX)
+6 WRITE !,SDX
+7 QUIT
+8 ;
XMX(X,Y) ;Set message text value
+1 SET $EXTRACT(SDX,X)=Y
+2 QUIT
+3 ;
XML(X) ;Set message text line
+1 ; ^XTMP("SD53P227",3,#) = E-mail report of all records
+2 SET SDL=SDL+1
+3 SET @SDTEMP@(3,SDL)=X
+4 QUIT
+5 ;
DT(SDDT) ;Format slashed date - (Original date/time with seconds)
+1 QUIT $EXTRACT(SDDT,4,5)_"/"_$EXTRACT(SDDT,6,7)_"/"_(17+$EXTRACT(SDDT))_$EXTRACT(SDDT,2,3)_"@"_$PIECE(SDDT,".",2)
+2 ;
DTT(SDDT) ;Format slashed date - (New date/time without seconds)
+1 ;error msg's will kick out
IF $EXTRACT(SDDT)'?1N
QUIT SDDT
+2 QUIT $EXTRACT(SDDT,4,5)_"/"_$EXTRACT(SDDT,6,7)_"/"_(17+$EXTRACT(SDDT))_$EXTRACT(SDDT,2,3)_"@"_$EXTRACT($PIECE(SDDT,".",2)_"0000",1,4)
+3 ;
HDR(SDI) ; Print header
+1 SET (SDX,X)=""
+2 IF PAGE
IF CRT
Begin DoDot:1
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET EXIT=1
QUIT
+5 SET EXIT='+$GET(Y)
End DoDot:1
IF EXIT
QUIT
+6 WRITE @IOF
+7 SET PAGE=PAGE+1
SET X="Page: "_PAGE
SET SDX=RUNDT
SET $EXTRACT(SDX,(80-$LENGTH(X)))=X
+8 WRITE TITLE,!,SDX,!,$SELECT(SDI=1:SUBT1,1:SUBT2),!,HEAD1,!,DASH
+9 QUIT
+10 ;
MHDR(SDI) ; Sets up the Mail msg header
+1 SET (SDX,X)=""
SET X="Page: 1"
SET SDX=RUNDT
SET $EXTRACT(SDX,(80-$LENGTH(X)))=X
+2 DO XML("")
DO XML(TITLE)
DO XML(SDX)
+3 SET SDX=""
SET X="Summary of Encounters"
SET $EXTRACT(SDX,(80-$LENGTH(X)\2))=X
+4 DO XML(SDX)
DO XML(DASH)
+5 QUIT
+6 ;
TOTAL(SDI,TOTALS,Y) ; Print out totals
+1 SET X="Total Encounters "
+2 SET X=X_$SELECT(SDI=1:"Unsendable:",SDI=2:"Flagged...:",SDI=3:"Searched..:",1:"")
+3 SET X=X_$JUSTIFY(+$PIECE(TOTALS,U,SDI),10)
+4 WRITE !,X
+5 IF Y
DO XML(X)
+6 QUIT
+7 ;
HEAD ; Setup header and sub-header lines
+1 NEW X
+2 SET SDTEMP="^XTMP(""SD53P227"")"
SET $PIECE(DASH,"-",80)=""
SET X=TITLE
+3 IF SDRTYP="R"
SET X=$PIECE(TITLE," & Cleanup")
+4 SET TITLE=""
SET $EXTRACT(TITLE,(80-$LENGTH(X)\2))=X
SET X=""
+5 SET X="Date Run: "_$PIECE($$FMTE^XLFDT(TIMESTRT),":",1,2)
SET $EXTRACT(RUNDT,(80-$LENGTH(X)\2))=X
SET X=""
+6 SET X="Error listing of Encounters not updated"
+7 SET $EXTRACT(SUBT1,(80-$LENGTH(X)\2))=X
+8 SET X="Preview list of Encounters to be updated"
+9 IF FIX
SET X="Encounters Updated and Flagged for Retransmission"
+10 SET $EXTRACT(SUBT2,(80-$LENGTH(X)\2))=X
SET X=""
+11 ;
+12 DO XMX(1,"Patient")
DO XMX(25,"SSN")
DO XMX(37,"Location")
DO XMX(60,"Encounter Date/Time")
+13 SET HEAD1=SDX
+14 QUIT
+15 ;
NOFIND ; Nothing to report
+1 NEW DASH,HEAD1,LINE,SDI,SDL,SDX,STR
+2 NEW PAGE,SUBT1,SUBT2,X,Y
+3 SET (SDI,SDL,SDX,STR,SUBT1,SUBT2,X,Y)=""
+4 SET (EXIT,PAGE,SDL)=0
+5 DO HEAD
DO HDR(1)
+6 ;kill E-mail node
KILL @SDTEMP@(3)
+7 SET X="No Outpatient Encounter 421 Error records found."
+8 WRITE !!,X
+9 DO XML("")
DO XML(X)
DO XML("")
+10 SET X="<End of Report>"
+11 WRITE !!,X
+12 DO XML(X)
DO XML("")
+13 QUIT
