SCENIA1 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS ; 09 Oct 98 3:03 PM
;;5.3;Scheduling;**66,154,323,378**;AUG 13, 1993
;
VE ; View Expanded Error
N SDHDR1,SDHDR2
S SDHDR1=VALMHDR(1)
S SDHDR2=VALMHDR(2)
S VALMBCK=""
D EN^SCENIB0
S VALMBCK="R"
Q
;
CE ; Entry point for getting corrective action for error and executing it.
; Variables
; SCXER - Ptr to 409.76
; SCEN - Ptr to 409.75
; SDXMT - Ptr to 409.73
;
N SCXER,SCEN
;;;; MOD
K ^TMP("SCENI COR",$J)
;
D SELERM("O")
Q:'$D(SCXER)
;
;;;;; MOD
;F I=1:1 S SCTEXT=$P($T(HDR+I),";;",2) Q:SCTEXT["$$END" D
;. W !?2,SCTEXT
;
S SCEN=0
S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
F S SCEN=$O(SCXER(SCEN)) Q:'SCEN D
. Q:'$D(^SD(409.75,SCEN,0))
. S SCCOR=$G(^SD(409.76,$P(^SD(409.75,SCEN,0),U,2),"COR"))
. I SCCOR="" D ERMSG(1) Q
.;;;;;; MOD
. Q:$D(^TMP("SCENI COR",$J,$P(SCCOR,"(")))
. W !!,$G(^SD(409.76,$P(^SD(409.75,SCEN,0),U,2),1))
. X SCCOR
. I 'RTN D ERMSG(2) ;;;Q
.;;;;; MOD
. S ^TMP("SCENI COR",$J,$P(SCCOR,"("))=""
;
; ** After correcting selected errors, fire off the validator and reflag
; transmission entry
W !,"Performing Ambulatory Care Validation Checks..."
S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
I RTN<0 D ERMSG(5) G CEQ
S RTN=$$SETRFLG(SDXMT)
I RTN<0 D ERMSG(3) G CEQ
;
;;;;; MOD
K ^TMP("SCENI COR",$J)
CEQ Q
;
EDI() ; Entry point for ENCOUNTER INFORMATION corrective action
S SDOK=0
D EI^SCENIA2
Q SDOK
;
DEM1() ; Entry point for correction logic
S SDOK=0
D DEM
Q SDOK
;
DEM ; Entry point for the SCENI PATIENT DEMOGRAPHICS protocol
N DFN,SDXMT,RTN
;
S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
D FULL^VALM1
;SD*5.3*323 add sensitive record warning if applicable
;reference to DGRPU1 allowed in Integration Agreement 413
N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
D QUES^DGRPU1(DFN,"ADD3")
;
I '$D(SDOK) D
. W !,"Performing Ambulatory Care Validation Checks..."
. S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
. ;;; MOD
. I RTN<0 D ERMSG(5) Q ;G DEMQ
. S RTN=$$SETRFLG(SDXMT)
. I RTN<0 D ERMSG(3) Q ;G DEMQ
I $D(SDOK) S SDOK=1
DEMQ Q
;
INTV() ; Entry point for correction logic for checkout errors
S SDOK=0
D CO
Q SDOK
;
CO ; Entry point for SCENI CHECKOUT INTERVIEW
N SDXMT,SCENFLG,SDOE,SDDT,SDOEND
K SCINF
;SD*5.3*323 add sensitive record warning if applicable next 5 lines
N DFN
S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
D FULL^VALM1
N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
S SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
I SCSTAT D G COQ
. D FULL^VALM1
. W !!,$CHAR(7),"This is a deleted encounter. Checkout information cannot be changed!"
. D PAUSE^VALM1
;
S SDOE=$P(^SD(409.73,SDXMT,0),U,2)
S SDOEND=$G(^SCE(+SDOE,0))
S SDCOHDL="",SCENFLG=1,VALMBCK=""
;
I $P(SDOEND,U,8)=2,$P(SDOEND,U,6)="" D ADDEDIT(SDOEND) I 1
E D EN^SDCO6
;
S VALMBCK="R"
;
I '$D(SDOK) D
. W !,"Performing Ambulatory Care Validation Checks..."
. S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
. ;;; MOD
. I RTN<0 D ERMSG(5) Q ;G COQ
. S RTN=$$SETRFLG(SDXMT)
. I RTN<0 D ERMSG(3) Q ;G COQ
I $D(SDOK) S SDOK=1
COQ ;
Q
;
ADDEDIT(SDOEND) ;this is to edit add/edits
N VAR
Q:'$P(SDOEND,U,5)
S VAR=$$INTV^PXAPI("ADDEDIT","SD","PIMS",$P(SDOEND,U,5),"",$P(SDOEND,U,2))
Q
;
LEDT() ;
S SDOK=0
D LE
Q SDOK
;
LE ; Entry point patient load edit.
N DFN,SDXMT
;
S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
S VALMBCK="",DGNEW=0
D FULL^VALM1
;SD*5.3*323 add sensitive record warning if applicable
N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
D A1^DG10
I '$D(SDOK) D
. W !,"Performing Ambulatory Care Validation Checks."
. S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
. ;;;;; MOD
. I RTN<0 D ERMSG(5) Q ;G LEQ
. S RTN=$$SETRFLG(SDXMT)
. I RTN<0 D ERMSG(3) Q ;G LEQ
I $D(SDOK) S SDOK=1
LEQ ;
Q
;
REFLG() ; Entry point for reflag correction action
;;;; MOD
;S SDOK=0
;D FLG
;Q SDOK
Q 1
;
FLG ; Entry point for Reflag Transmission protocol
N SDXMT
;
S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
W !,"Performing Ambulatory Care Validation Checks..."
S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
I RTN<0 D ERMSG(5) G FLQ
S RTN=$$SETRFLG(SDXMT)
I RTN<0 D ERMSG(3) G FLQ
;;;; MOD
;I $D(SDOK) S SDOK=1
FLQ Q
;
SETRFLG(SDXMT) ;
; Input
; SDXMT - Pointer to Transmission File, #409.73
;
; Output
; -1 - There was a problem reflaging the transmission
; 0 - No errors occured
; 1 - The entry is already flagged for transmission
;
S RESULT=-1
S STATUS=$P($G(^SD(409.73,SDXMT,0)),U,4)
I STATUS S RESULT=1
E D
. D XMITFLAG^SCDXFU01(SDXMT,0),STREEVNT^SCDXFU01(SDXMT,0)
. S RESULT=0
D INIT^SCENIA0
D RE^VALM4
Q RESULT
;
MSG(SDTEXT,SDEXMT) ;
W:SDTEXT]"" !!,SDTEXT,!
S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR K DIR
Q 1
;
SELERM(FLG) ; Select Multiple entries
N VALMY
;
D FULL^VALM1
I $G(FLG)']"" S FLG="O"
D EN^VALM2(XQORNOD(0),FLG) S VALMI=0
I '$D(VALMY) S VALMBCK="R" Q
S SDN1=""
F S SDN1=$O(VALMY(SDN1)) Q:'SDN1 D
. S SCEPTR="",SCEPTR=$O(^TMP("SCENI ERR",$J,"DA",SDN1,SCEPTR))
. I SCEPTR>0 S SCXER(SCEPTR)=""
Q
;
ERMSG(MSGN) ;
D FULL^VALM1
S SCTEXT=$P($T(@MSGN),";;",2)
W $CHAR(7)
W !!?5,SCTEXT,!
S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR K DIR
S VALMBCK="R"
Q
;
EXIT ;
I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
Q
;
HDR ;
;;Selecting a range of errors to correct may result in one or
;;more similar errors being removed from the display list after
;;correction of the initial error.
;;$$END
;
1 ;;No correction logic has been defined for this error.
2 ;;Unable to execute Correction Logic.
3 ;;There was a problem trying to flag this entry for retransmission.
4 ;;This transmission entry is already flagged for transmission.
5 ;;The validator encountered a problem with this transmission entry.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCENIA1 6223 printed Apr 09, 2024@22:04:37 Page 2
SCENIA1 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS ; 09 Oct 98 3:03 PM
+1 ;;5.3;Scheduling;**66,154,323,378**;AUG 13, 1993
+2 ;
VE ; View Expanded Error
+1 NEW SDHDR1,SDHDR2
+2 SET SDHDR1=VALMHDR(1)
+3 SET SDHDR2=VALMHDR(2)
+4 SET VALMBCK=""
+5 DO EN^SCENIB0
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
CE ; Entry point for getting corrective action for error and executing it.
+1 ; Variables
+2 ; SCXER - Ptr to 409.76
+3 ; SCEN - Ptr to 409.75
+4 ; SDXMT - Ptr to 409.73
+5 ;
+6 NEW SCXER,SCEN
+7 ;;;; MOD
+8 KILL ^TMP("SCENI COR",$JOB)
+9 ;
+10 DO SELERM("O")
+11 if '$DATA(SCXER)
QUIT
+12 ;
+13 ;;;;; MOD
+14 ;F I=1:1 S SCTEXT=$P($T(HDR+I),";;",2) Q:SCTEXT["$$END" D
+15 ;. W !?2,SCTEXT
+16 ;
+17 SET SCEN=0
+18 SET SDXMT=$GET(^TMP("SCENI XMT",$JOB,0))
if 'SDXMT
QUIT
+19 FOR
SET SCEN=$ORDER(SCXER(SCEN))
if 'SCEN
QUIT
Begin DoDot:1
+20 if '$DATA(^SD(409.75,SCEN,0))
QUIT
+21 SET SCCOR=$GET(^SD(409.76,$PIECE(^SD(409.75,SCEN,0),U,2),"COR"))
+22 IF SCCOR=""
DO ERMSG(1)
QUIT
+23 ;;;;;; MOD
+24 if $DATA(^TMP("SCENI COR",$JOB,$PIECE(SCCOR,"(")))
QUIT
+25 WRITE !!,$GET(^SD(409.76,$PIECE(^SD(409.75,SCEN,0),U,2),1))
+26 XECUTE SCCOR
+27 ;;;Q
IF 'RTN
DO ERMSG(2)
+28 ;;;;; MOD
+29 SET ^TMP("SCENI COR",$JOB,$PIECE(SCCOR,"("))=""
End DoDot:1
+30 ;
+31 ; ** After correcting selected errors, fire off the validator and reflag
+32 ; transmission entry
+33 WRITE !,"Performing Ambulatory Care Validation Checks..."
+34 SET RTN=$$VALIDATE^SCMSVUT2(SDXMT)
+35 IF RTN<0
DO ERMSG(5)
GOTO CEQ
+36 SET RTN=$$SETRFLG(SDXMT)
+37 IF RTN<0
DO ERMSG(3)
GOTO CEQ
+38 ;
+39 ;;;;; MOD
+40 KILL ^TMP("SCENI COR",$JOB)
CEQ QUIT
+1 ;
EDI() ; Entry point for ENCOUNTER INFORMATION corrective action
+1 SET SDOK=0
+2 DO EI^SCENIA2
+3 QUIT SDOK
+4 ;
DEM1() ; Entry point for correction logic
+1 SET SDOK=0
+2 DO DEM
+3 QUIT SDOK
+4 ;
DEM ; Entry point for the SCENI PATIENT DEMOGRAPHICS protocol
+1 NEW DFN,SDXMT,RTN
+2 ;
+3 SET DFN=$GET(^TMP("SCENI DFN",$JOB,0))
if 'DFN
QUIT
+4 SET SDXMT=$GET(^TMP("SCENI XMT",$JOB,0))
if 'SDXMT
QUIT
+5 DO FULL^VALM1
+6 ;SD*5.3*323 add sensitive record warning if applicable
+7 ;reference to DGRPU1 allowed in Integration Agreement 413
+8 NEW DIC
SET DIC=2
SET DIC(0)="EM"
SET X="`"_DFN
DO ^DIC
IF Y=-1
SET SDOK=1
QUIT
+9 DO QUES^DGRPU1(DFN,"ADD3")
+10 ;
+11 IF '$DATA(SDOK)
Begin DoDot:1
+12 WRITE !,"Performing Ambulatory Care Validation Checks..."
+13 SET RTN=$$VALIDATE^SCMSVUT2(SDXMT)
+14 ;;; MOD
+15 ;G DEMQ
IF RTN<0
DO ERMSG(5)
QUIT
+16 SET RTN=$$SETRFLG(SDXMT)
+17 ;G DEMQ
IF RTN<0
DO ERMSG(3)
QUIT
End DoDot:1
+18 IF $DATA(SDOK)
SET SDOK=1
DEMQ QUIT
+1 ;
INTV() ; Entry point for correction logic for checkout errors
+1 SET SDOK=0
+2 DO CO
+3 QUIT SDOK
+4 ;
CO ; Entry point for SCENI CHECKOUT INTERVIEW
+1 NEW SDXMT,SCENFLG,SDOE,SDDT,SDOEND
+2 KILL SCINF
+3 ;SD*5.3*323 add sensitive record warning if applicable next 5 lines
+4 NEW DFN
+5 SET DFN=$GET(^TMP("SCENI DFN",$JOB,0))
if 'DFN
QUIT
+6 SET SDXMT=$GET(^TMP("SCENI XMT",$JOB,0))
if 'SDXMT
QUIT
+7 DO FULL^VALM1
+8 NEW DIC
SET DIC=2
SET DIC(0)="EM"
SET X="`"_DFN
DO ^DIC
IF Y=-1
SET SDOK=1
QUIT
+9 SET SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
+10 IF SCSTAT
Begin DoDot:1
+11 DO FULL^VALM1
+12 WRITE !!,$CHAR(7),"This is a deleted encounter. Checkout information cannot be changed!"
+13 DO PAUSE^VALM1
End DoDot:1
GOTO COQ
+14 ;
+15 SET SDOE=$PIECE(^SD(409.73,SDXMT,0),U,2)
+16 SET SDOEND=$GET(^SCE(+SDOE,0))
+17 SET SDCOHDL=""
SET SCENFLG=1
SET VALMBCK=""
+18 ;
+19 IF $PIECE(SDOEND,U,8)=2
IF $PIECE(SDOEND,U,6)=""
DO ADDEDIT(SDOEND)
IF 1
+20 IF '$TEST
DO EN^SDCO6
+21 ;
+22 SET VALMBCK="R"
+23 ;
+24 IF '$DATA(SDOK)
Begin DoDot:1
+25 WRITE !,"Performing Ambulatory Care Validation Checks..."
+26 SET RTN=$$VALIDATE^SCMSVUT2(SDXMT)
+27 ;;; MOD
+28 ;G COQ
IF RTN<0
DO ERMSG(5)
QUIT
+29 SET RTN=$$SETRFLG(SDXMT)
+30 ;G COQ
IF RTN<0
DO ERMSG(3)
QUIT
End DoDot:1
+31 IF $DATA(SDOK)
SET SDOK=1
COQ ;
+1 QUIT
+2 ;
ADDEDIT(SDOEND) ;this is to edit add/edits
+1 NEW VAR
+2 if '$PIECE(SDOEND,U,5)
QUIT
+3 SET VAR=$$INTV^PXAPI("ADDEDIT","SD","PIMS",$PIECE(SDOEND,U,5),"",$PIECE(SDOEND,U,2))
+4 QUIT
+5 ;
LEDT() ;
+1 SET SDOK=0
+2 DO LE
+3 QUIT SDOK
+4 ;
LE ; Entry point patient load edit.
+1 NEW DFN,SDXMT
+2 ;
+3 SET DFN=$GET(^TMP("SCENI DFN",$JOB,0))
if 'DFN
QUIT
+4 SET SDXMT=$GET(^TMP("SCENI XMT",$JOB,0))
if 'SDXMT
QUIT
+5 SET VALMBCK=""
SET DGNEW=0
+6 DO FULL^VALM1
+7 ;SD*5.3*323 add sensitive record warning if applicable
+8 NEW DIC
SET DIC=2
SET DIC(0)="EM"
SET X="`"_DFN
DO ^DIC
IF Y=-1
SET SDOK=1
QUIT
+9 DO A1^DG10
+10 IF '$DATA(SDOK)
Begin DoDot:1
+11 WRITE !,"Performing Ambulatory Care Validation Checks."
+12 SET RTN=$$VALIDATE^SCMSVUT2(SDXMT)
+13 ;;;;; MOD
+14 ;G LEQ
IF RTN<0
DO ERMSG(5)
QUIT
+15 SET RTN=$$SETRFLG(SDXMT)
+16 ;G LEQ
IF RTN<0
DO ERMSG(3)
QUIT
End DoDot:1
+17 IF $DATA(SDOK)
SET SDOK=1
LEQ ;
+1 QUIT
+2 ;
REFLG() ; Entry point for reflag correction action
+1 ;;;; MOD
+2 ;S SDOK=0
+3 ;D FLG
+4 ;Q SDOK
+5 QUIT 1
+6 ;
FLG ; Entry point for Reflag Transmission protocol
+1 NEW SDXMT
+2 ;
+3 SET SDXMT=$GET(^TMP("SCENI XMT",$JOB,0))
if 'SDXMT
QUIT
+4 WRITE !,"Performing Ambulatory Care Validation Checks..."
+5 SET RTN=$$VALIDATE^SCMSVUT2(SDXMT)
+6 IF RTN<0
DO ERMSG(5)
GOTO FLQ
+7 SET RTN=$$SETRFLG(SDXMT)
+8 IF RTN<0
DO ERMSG(3)
GOTO FLQ
+9 ;;;; MOD
+10 ;I $D(SDOK) S SDOK=1
FLQ QUIT
+1 ;
SETRFLG(SDXMT) ;
+1 ; Input
+2 ; SDXMT - Pointer to Transmission File, #409.73
+3 ;
+4 ; Output
+5 ; -1 - There was a problem reflaging the transmission
+6 ; 0 - No errors occured
+7 ; 1 - The entry is already flagged for transmission
+8 ;
+9 SET RESULT=-1
+10 SET STATUS=$PIECE($GET(^SD(409.73,SDXMT,0)),U,4)
+11 IF STATUS
SET RESULT=1
+12 IF '$TEST
Begin DoDot:1
+13 DO XMITFLAG^SCDXFU01(SDXMT,0)
DO STREEVNT^SCDXFU01(SDXMT,0)
+14 SET RESULT=0
End DoDot:1
+15 DO INIT^SCENIA0
+16 DO RE^VALM4
+17 QUIT RESULT
+18 ;
MSG(SDTEXT,SDEXMT) ;
+1 if SDTEXT]""
WRITE !!,SDTEXT,!
+2 SET DIR(0)="FAO"
SET DIR("A")="Press ENTER to continue "
DO ^DIR
KILL DIR
+3 QUIT 1
+4 ;
SELERM(FLG) ; Select Multiple entries
+1 NEW VALMY
+2 ;
+3 DO FULL^VALM1
+4 IF $GET(FLG)']""
SET FLG="O"
+5 DO EN^VALM2(XQORNOD(0),FLG)
SET VALMI=0
+6 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT
+7 SET SDN1=""
+8 FOR
SET SDN1=$ORDER(VALMY(SDN1))
if 'SDN1
QUIT
Begin DoDot:1
+9 SET SCEPTR=""
SET SCEPTR=$ORDER(^TMP("SCENI ERR",$JOB,"DA",SDN1,SCEPTR))
+10 IF SCEPTR>0
SET SCXER(SCEPTR)=""
End DoDot:1
+11 QUIT
+12 ;
ERMSG(MSGN) ;
+1 DO FULL^VALM1
+2 SET SCTEXT=$PIECE($TEXT(@MSGN),";;",2)
+3 WRITE $CHAR(7)
+4 WRITE !!?5,SCTEXT,!
+5 SET DIR(0)="FAO"
SET DIR("A")="Press ENTER to continue "
DO ^DIR
KILL DIR
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
EXIT ;
+1 IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
+2 QUIT
+3 ;
HDR ;
+1 ;;Selecting a range of errors to correct may result in one or
+2 ;;more similar errors being removed from the display list after
+3 ;;correction of the initial error.
+4 ;;$$END
+5 ;
1 ;;No correction logic has been defined for this error.
2 ;;Unable to execute Correction Logic.
3 ;;There was a problem trying to flag this entry for retransmission.
4 ;;This transmission entry is already flagged for transmission.
5 ;;The validator encountered a problem with this transmission entry.
