SCENIA0 ;ALB/SCK - DISPLAY INCOMPLETE ENCOUNTER ERRORS ; 09-MAY-1997
;;5.3;Scheduling;**66,577**;AUG 13, 1993;Build 2
;
EN ; -- main entry point for SCENI INCOMPLETE ENC DISPLAY
; Variables
; SDOE - Ptr to #409.68
; SDCLN - Ptr to #44
; SDFLG - Deleted encounter or not
; SCINF - Encounter information array
;
N VALMCNT
S VALMBCK=""
K ^TMP("SCENI DFN",$J),^TMP("SCENI XMT",$J)
K VA,SDFLG
;
Q:'+SDXPTR
S SDFLG=$$OPENC^SCUTIE1(SDXPTR,"SCINF")
I SDFLG=-1,$D(SCINF("ERROR")) W !!,$G(SCINF("ERROR")) H 3 K SCINF Q ;SD*577
;
S DFN=SCINF("DFN")
S ^TMP("SCENI DFN",$J,0)=DFN
S ^TMP("SCENI XMT",$J,0)=+SDXPTR
D PID^VADPT6
D EN^VALM("SCENI INCOMPLETE ENC DISPLAY")
S VALMBCK="R"
Q
;
HDR ; -- header code
I '$G(VA("BID")) S DFN=SCINF("DFN") D PID^VADPT6
S VALMHDR(1)=" Patient: "_$$LOWER^VALM1($E($P(^DPT(SCINF("DFN"),0),U),1,25))
S VALMHDR(1)=$$SETSTR^VALM1("SSN: "_VA("BID"),VALMHDR(1),66,10)
S VALMHDR(2)=" Clinic: "_$E($P($G(^SC(SCINF("CLINIC"),0)),U),1,25)
S VALMHDR(2)=$$SETSTR^VALM1($S(SDFLG:"(DEL) ",1:" ")_"Encounter Date: "_$$FDTTM^VALM1(SCINF("ENCOUNTER")),VALMHDR(2),49,30)
Q
;
INIT ; -- init variables and list array
; Variables
; IW,IC,EC,EW,DC,DW,SC,SW - Col widths and positions
; SDECNT - Counter
;
K ^TMP("SCENI ERR",$J)
D CLEAN^VALM10
;
S BL="",$P(BL," ",30)=""
S X=VALMDDF("INDEX"),IC=$P(X,U,2),IW=$P(X,U,3)
S X=VALMDDF("SOURCE"),SC=$P(X,U,2),SW=$P(X,U,3)
S X=VALMDDF("ERROR"),EC=$P(X,U,2),EW=$P(X,U,3)
S X=VALMDDF("DESCRIPTION"),DC=$P(X,U,2),DW=$P(X,U,3)
;
D BLD
I '$D(^TMP("SCENI ERR",$J)) D Q
. S (SDECNT,VALMCNT)=0
. D SET(" "),SET("No Errors found.")
Q
;
BLD ; Build display global for error entries in the error file
;
S (SDECNT,VALMCNT)=0,SDEPTR=""
F S SDEPTR=$O(^SD(409.75,"B",SDXPTR,SDEPTR)) Q:'SDEPTR D
. Q:'$D(^SD(409.75,SDEPTR))
. D BLD1(SDEPTR)
Q
;
BLD1(SDEPTR) ; Build display line
; Input
; SDEPTR - Ptr to #409.75
;
; Variables
; SDX - Local variable
; ERNODE - Error table node 0
; ERNODE1 - Error table node 1
; SDERR - Error code
;
N SDSRC
;
S SDECNT=SDECNT+1,SDX="",$P(SDX," ",VALMWD+1)=""
;W:(SDECNT#10)=0 "."
;
S SDERR=$P(^SD(409.75,SDEPTR,0),U,2)
Q:'SDERR
S ERNODE=$G(^SD(409.76,SDERR,0))
S ERNODE1=$G(^SD(409.76,SDERR,1))
;
S SDX=$E(SDX,1,IC-1)_$E(SDECNT_BL,1,IW)_$E(SDX,IC+IW+1,VALMWD)
S SDSRC=$P(ERNODE,U,2)
S SDX=$E(SDX,1,SC-1)_$E($S(SDSRC="V":"VISTA",SDSRC="N":"NPCD ",1:"UNK ")_BL,1,SW)_$E(SDX,SC+SW+1,VALMWD)
S SDX=$E(SDX,1,EC-1)_$E($P(ERNODE,U)_BL,1,EW)_$E(SDX,EC+EW+1,VALMWD)
S SDX=$E(SDX,1,DC-1)_$E(ERNODE1_BL,1,DW)_$E(SDX,DC+DW+1,VALMWD)
D SET(SDX)
Q
;
SET(X) ; Sets formatted display string into TMP global
S VALMCNT=VALMCNT+1,^TMP("SCENI ERR",$J,VALMCNT,0)=X
Q:'SDECNT
S ^TMP("SCENI ERR",$J,"IDX",VALMCNT,SDECNT)=SDEPTR_U_$P(ERNODE,U)
S ^TMP("SCENI ERR",$J,"DA",SDECNT,SDEPTR)=""
;S ^TMP("SCENI ERR",$J,"XMT",SDECNT,SDXPTR)=""
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("SCENI ERR",$J),^TMP("SCENI DFN",$J),^TMP("SCENI XMT",$J),VA
K BL,IW,IC,EC,EW,DC,DW,SC,SW,SDECNT,SCINF,SDFLG,SDEPTR,SDX,ERNODE,ERNODE1,SDERR,SCCOR,SCTEXT
K SDN1,SDN2,SCEPTR,SDOK,SINDX,DIE,DR,STATUS,RESULT
I $G(FLG1),$D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCENIA0 3479 printed Apr 09, 2024@21:39:53 Page 2
SCENIA0 ;ALB/SCK - DISPLAY INCOMPLETE ENCOUNTER ERRORS ; 09-MAY-1997
+1 ;;5.3;Scheduling;**66,577**;AUG 13, 1993;Build 2
+2 ;
EN ; -- main entry point for SCENI INCOMPLETE ENC DISPLAY
+1 ; Variables
+2 ; SDOE - Ptr to #409.68
+3 ; SDCLN - Ptr to #44
+4 ; SDFLG - Deleted encounter or not
+5 ; SCINF - Encounter information array
+6 ;
+7 NEW VALMCNT
+8 SET VALMBCK=""
+9 KILL ^TMP("SCENI DFN",$JOB),^TMP("SCENI XMT",$JOB)
+10 KILL VA,SDFLG
+11 ;
+12 if '+SDXPTR
QUIT
+13 SET SDFLG=$$OPENC^SCUTIE1(SDXPTR,"SCINF")
+14 ;SD*577
IF SDFLG=-1
IF $DATA(SCINF("ERROR"))
WRITE !!,$GET(SCINF("ERROR"))
HANG 3
KILL SCINF
QUIT
+15 ;
+16 SET DFN=SCINF("DFN")
+17 SET ^TMP("SCENI DFN",$JOB,0)=DFN
+18 SET ^TMP("SCENI XMT",$JOB,0)=+SDXPTR
+19 DO PID^VADPT6
+20 DO EN^VALM("SCENI INCOMPLETE ENC DISPLAY")
+21 SET VALMBCK="R"
+22 QUIT
+23 ;
HDR ; -- header code
+1 IF '$GET(VA("BID"))
SET DFN=SCINF("DFN")
DO PID^VADPT6
+2 SET VALMHDR(1)=" Patient: "_$$LOWER^VALM1($EXTRACT($PIECE(^DPT(SCINF("DFN"),0),U),1,25))
+3 SET VALMHDR(1)=$$SETSTR^VALM1("SSN: "_VA("BID"),VALMHDR(1),66,10)
+4 SET VALMHDR(2)=" Clinic: "_$EXTRACT($PIECE($GET(^SC(SCINF("CLINIC"),0)),U),1,25)
+5 SET VALMHDR(2)=$$SETSTR^VALM1($SELECT(SDFLG:"(DEL) ",1:" ")_"Encounter Date: "_$$FDTTM^VALM1(SCINF("ENCOUNTER")),VALMHDR(2),49,30)
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 ; Variables
+2 ; IW,IC,EC,EW,DC,DW,SC,SW - Col widths and positions
+3 ; SDECNT - Counter
+4 ;
+5 KILL ^TMP("SCENI ERR",$JOB)
+6 DO CLEAN^VALM10
+7 ;
+8 SET BL=""
SET $PIECE(BL," ",30)=""
+9 SET X=VALMDDF("INDEX")
SET IC=$PIECE(X,U,2)
SET IW=$PIECE(X,U,3)
+10 SET X=VALMDDF("SOURCE")
SET SC=$PIECE(X,U,2)
SET SW=$PIECE(X,U,3)
+11 SET X=VALMDDF("ERROR")
SET EC=$PIECE(X,U,2)
SET EW=$PIECE(X,U,3)
+12 SET X=VALMDDF("DESCRIPTION")
SET DC=$PIECE(X,U,2)
SET DW=$PIECE(X,U,3)
+13 ;
+14 DO BLD
+15 IF '$DATA(^TMP("SCENI ERR",$JOB))
Begin DoDot:1
+16 SET (SDECNT,VALMCNT)=0
+17 DO SET(" ")
DO SET("No Errors found.")
End DoDot:1
QUIT
+18 QUIT
+19 ;
BLD ; Build display global for error entries in the error file
+1 ;
+2 SET (SDECNT,VALMCNT)=0
SET SDEPTR=""
+3 FOR
SET SDEPTR=$ORDER(^SD(409.75,"B",SDXPTR,SDEPTR))
if 'SDEPTR
QUIT
Begin DoDot:1
+4 if '$DATA(^SD(409.75,SDEPTR))
QUIT
+5 DO BLD1(SDEPTR)
End DoDot:1
+6 QUIT
+7 ;
BLD1(SDEPTR) ; Build display line
+1 ; Input
+2 ; SDEPTR - Ptr to #409.75
+3 ;
+4 ; Variables
+5 ; SDX - Local variable
+6 ; ERNODE - Error table node 0
+7 ; ERNODE1 - Error table node 1
+8 ; SDERR - Error code
+9 ;
+10 NEW SDSRC
+11 ;
+12 SET SDECNT=SDECNT+1
SET SDX=""
SET $PIECE(SDX," ",VALMWD+1)=""
+13 ;W:(SDECNT#10)=0 "."
+14 ;
+15 SET SDERR=$PIECE(^SD(409.75,SDEPTR,0),U,2)
+16 if 'SDERR
QUIT
+17 SET ERNODE=$GET(^SD(409.76,SDERR,0))
+18 SET ERNODE1=$GET(^SD(409.76,SDERR,1))
+19 ;
+20 SET SDX=$EXTRACT(SDX,1,IC-1)_$EXTRACT(SDECNT_BL,1,IW)_$EXTRACT(SDX,IC+IW+1,VALMWD)
+21 SET SDSRC=$PIECE(ERNODE,U,2)
+22 SET SDX=$EXTRACT(SDX,1,SC-1)_$EXTRACT($SELECT(SDSRC="V":"VISTA",SDSRC="N":"NPCD ",1:"UNK ")_BL,1,SW)_$EXTRACT(SDX,SC+SW+1,VALMWD)
+23 SET SDX=$EXTRACT(SDX,1,EC-1)_$EXTRACT($PIECE(ERNODE,U)_BL,1,EW)_$EXTRACT(SDX,EC+EW+1,VALMWD)
+24 SET SDX=$EXTRACT(SDX,1,DC-1)_$EXTRACT(ERNODE1_BL,1,DW)_$EXTRACT(SDX,DC+DW+1,VALMWD)
+25 DO SET(SDX)
+26 QUIT
+27 ;
SET(X) ; Sets formatted display string into TMP global
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("SCENI ERR",$JOB,VALMCNT,0)=X
+2 if 'SDECNT
QUIT
+3 SET ^TMP("SCENI ERR",$JOB,"IDX",VALMCNT,SDECNT)=SDEPTR_U_$PIECE(ERNODE,U)
+4 SET ^TMP("SCENI ERR",$JOB,"DA",SDECNT,SDEPTR)=""
+5 ;S ^TMP("SCENI ERR",$J,"XMT",SDECNT,SDXPTR)=""
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("SCENI ERR",$JOB),^TMP("SCENI DFN",$JOB),^TMP("SCENI XMT",$JOB),VA
+2 KILL BL,IW,IC,EC,EW,DC,DW,SC,SW,SDECNT,SCINF,SDFLG,SDEPTR,SDX,ERNODE,ERNODE1,SDERR,SCCOR,SCTEXT
+3 KILL SDN1,SDN2,SCEPTR,SDOK,SINDX,DIE,DR,STATUS,RESULT
+4 IF $GET(FLG1)
IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
+5 QUIT
