- SCENIA1 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS ; 09 Oct 98 3:03 PM
- ;;5.3;Scheduling;**66,154,323,378,1015**;AUG 13, 1993;Build 21
- ;
- 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.
- SCENIA1 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS ; 09 Oct 98 3:03 PM
- +1 ;;5.3;Scheduling;**66,154,323,378,1015**;AUG 13, 1993;Build 21
- +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.