Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCENIA0

SCENIA0.m

Go to the documentation of this file. 
  1. SCENIA0 ;ALB/SCK - DISPLAY INCOMPLETE ENCOUNTER ERRORS ; 09-MAY-1997
  1.  ;;5.3;Scheduling;**66,577**;AUG 13, 1993;Build 2
  1.  ;
  1. EN ; -- main entry point for SCENI INCOMPLETE ENC DISPLAY
  1.  ;   Variables
  1.  ;        SDOE  - Ptr to #409.68
  1.  ;        SDCLN - Ptr to #44
  1.  ;        SDFLG - Deleted encounter or not
  1.  ;        SCINF - Encounter information array
  1.  ;
  1.  N VALMCNT
  1.  S VALMBCK=""
  1.  K ^TMP("SCENI DFN",$J),^TMP("SCENI XMT",$J)
  1.  K VA,SDFLG
  1.  ;
  1.  Q:'+SDXPTR
  1.  S SDFLG=$$OPENC^SCUTIE1(SDXPTR,"SCINF")
  1.  I SDFLG=-1,$D(SCINF("ERROR")) W !!,$G(SCINF("ERROR")) H 3 K SCINF Q   ;SD*577
  1.  ;
  1.  S DFN=SCINF("DFN")
  1.  S ^TMP("SCENI DFN",$J,0)=DFN
  1.  S ^TMP("SCENI XMT",$J,0)=+SDXPTR
  1.  D PID^VADPT6
  1.  D EN^VALM("SCENI INCOMPLETE ENC DISPLAY")
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  I '$G(VA("BID")) S DFN=SCINF("DFN") D PID^VADPT6
  1.  S VALMHDR(1)="  Patient: "_$$LOWER^VALM1($E($P(^DPT(SCINF("DFN"),0),U),1,25))
  1.  S VALMHDR(1)=$$SETSTR^VALM1("SSN: "_VA("BID"),VALMHDR(1),66,10)
  1.  S VALMHDR(2)="   Clinic: "_$E($P($G(^SC(SCINF("CLINIC"),0)),U),1,25)
  1.  S VALMHDR(2)=$$SETSTR^VALM1($S(SDFLG:"(DEL) ",1:"      ")_"Encounter Date: "_$$FDTTM^VALM1(SCINF("ENCOUNTER")),VALMHDR(2),49,30)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  ;     Variables
  1.  ;       IW,IC,EC,EW,DC,DW,SC,SW - Col widths and positions
  1.  ;       SDECNT - Counter
  1.  ;
  1.  K ^TMP("SCENI ERR",$J)
  1.  D CLEAN^VALM10
  1.  ;
  1.  S BL="",$P(BL," ",30)=""
  1.  S X=VALMDDF("INDEX"),IC=$P(X,U,2),IW=$P(X,U,3)
  1.  S X=VALMDDF("SOURCE"),SC=$P(X,U,2),SW=$P(X,U,3)
  1.  S X=VALMDDF("ERROR"),EC=$P(X,U,2),EW=$P(X,U,3)
  1.  S X=VALMDDF("DESCRIPTION"),DC=$P(X,U,2),DW=$P(X,U,3)
  1.  ;
  1.  D BLD
  1.  I '$D(^TMP("SCENI ERR",$J)) D  Q
  1.  . S (SDECNT,VALMCNT)=0
  1.  . D SET(" "),SET("No Errors found.")
  1.  Q
  1.  ;
  1. BLD ;  Build display global for error entries in the error file
  1.  ;
  1.  S (SDECNT,VALMCNT)=0,SDEPTR=""
  1.  F  S SDEPTR=$O(^SD(409.75,"B",SDXPTR,SDEPTR)) Q:'SDEPTR  D
  1.  . Q:'$D(^SD(409.75,SDEPTR))
  1.  . D BLD1(SDEPTR)
  1.  Q
  1.  ;
  1. BLD1(SDEPTR) ;   Build display line
  1.  ;    Input
  1.  ;         SDEPTR - Ptr to #409.75
  1.  ;
  1.  ;    Variables
  1.  ;        SDX     - Local variable
  1.  ;        ERNODE  - Error table node 0
  1.  ;        ERNODE1 - Error table node 1
  1.  ;        SDERR   - Error code
  1.  ;
  1.  N SDSRC
  1.  ;
  1.  S SDECNT=SDECNT+1,SDX="",$P(SDX," ",VALMWD+1)=""
  1.  ;W:(SDECNT#10)=0 "."
  1.  ;
  1.  S SDERR=$P(^SD(409.75,SDEPTR,0),U,2)
  1.  Q:'SDERR
  1.  S ERNODE=$G(^SD(409.76,SDERR,0))
  1.  S ERNODE1=$G(^SD(409.76,SDERR,1))
  1.  ;
  1.  S SDX=$E(SDX,1,IC-1)_$E(SDECNT_BL,1,IW)_$E(SDX,IC+IW+1,VALMWD)
  1.  S SDSRC=$P(ERNODE,U,2)
  1.  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)
  1.  S SDX=$E(SDX,1,EC-1)_$E($P(ERNODE,U)_BL,1,EW)_$E(SDX,EC+EW+1,VALMWD)
  1.  S SDX=$E(SDX,1,DC-1)_$E(ERNODE1_BL,1,DW)_$E(SDX,DC+DW+1,VALMWD)
  1.  D SET(SDX)
  1.  Q
  1.  ;
  1. SET(X) ;   Sets formatted display string into TMP global
  1.  S VALMCNT=VALMCNT+1,^TMP("SCENI ERR",$J,VALMCNT,0)=X
  1.  Q:'SDECNT
  1.  S ^TMP("SCENI ERR",$J,"IDX",VALMCNT,SDECNT)=SDEPTR_U_$P(ERNODE,U)
  1.  S ^TMP("SCENI ERR",$J,"DA",SDECNT,SDEPTR)=""
  1.  ;S ^TMP("SCENI ERR",$J,"XMT",SDECNT,SDXPTR)=""
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("SCENI ERR",$J),^TMP("SCENI DFN",$J),^TMP("SCENI XMT",$J),VA
  1.  K BL,IW,IC,EC,EW,DC,DW,SC,SW,SDECNT,SCINF,SDFLG,SDEPTR,SDX,ERNODE,ERNODE1,SDERR,SCCOR,SCTEXT
  1.  K SDN1,SDN2,SCEPTR,SDOK,SINDX,DIE,DR,STATUS,RESULT
  1.  I $G(FLG1),$D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
  1.  Q