- 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