SCENI0 ;ALB/SCK - INCOMPLETE ENCOUNTER MGMT MAIN LM DISPLAY ; 07-MAY-1997
;;5.3;Scheduling;**66**;AUG 13, 1993
;
EN ; Entry point for IEMM LM display
; Variables
; VAUTC,VAUTD - Clinic and Division o/m/a arrays
; SDENTYP - Search type, P:patient, C:Clinic, E:Error Code
; SDCLN - Clinic from selection lookup
; SDDT - Date range for search, Begin^End format
; SDY - Local variable used in selection criteria
; SDEVAL - Error code value
; SDFN - Patient DFN for local use
; SDIEMM - Flag for IEMM
;
N SDENTYP,DFN,SDCLN,SDDT,VAUTC,VAUTD,SDY,SDEVAL,SDFN,SDIEMM
K X,SDB,XQORNOD,DA,DR,DIE,%B
;
AGN Q:'$$ENTRY^SCUTIE2(.SDY)
I $G(SDENTYP)']"" G AGN
;
I SDENTYP["P" D
. S SDFN=+SDY
. S VAUTC=1
. S X=$P($G(^DG(43,1,"SCLR")),U,12)
. S SDDT=$$FMADD^XLFDT($$DT^XLFDT,-X)_U_$$DT^XLFDT
;
I SDENTYP["C" D G:'$$ASKDT^SCENI01(.SDDT) ENQ
. S SDCLN=+SDY
. S VAUTC=0,VAUTC(+SDY)=$P(^SC(+SDY,0),U)
;
I SDENTYP["E" D G:'$$ASKDT^SCENI01(.SDDT) ENQ
. S VAUTC=1
. S SDEVAL=+SDY
;
S VAUTD=1
EN1 D WAIT^DICD
I $G(FLG1) K XQORS,VALMEVL
S SDIEMM=1
D EN^VALM("SCENI INCOMPLETE ENC MGT")
ENQ Q
;
ENP(SDXPTR) ; Entry point for Data validation, Patient Predefined
; This entry point will jump to the second LM screen and display any
; errors for the encounter.
;
; Input
; SDXMT - Pointer to transmission file, 409.73
;
; Variables
; FLG1 - Flag for patient defined entry point
;
N FLG1,SDIEMM
S SDIEMM=1
;S VALMBCK="R"
S FLG1=1
D EN^SCENIA0
Q
;
HDR ; -- header code
N SDCLN
;
S VALMHDR(1)="Date Range: "_$$FDATE^VALM1($P(SDDT,U))_" thru "_$$FDATE^VALM1($P(SDDT,U,2))
;
I SDENTYP["P" D
. S VALMHDR(2)=" Patient: "_$P(^DPT(SDFN,0),U)
I SDENTYP["C" D
. S SDCLN=$O(VAUTC(0))
. S VALMHDR(2)=" Clinic: "_$E(VAUTC(SDCLN),1,25)
I SDENTYP["E" D
. S VALMHDR(2)="Error Code: "_$E($P(^SD(409.76,SDEVAL,1),U),1,60)
S VALMSG="'*' Deleted Encounter Enter ?? for more actions"
Q
;
INIT ; -- init variables and list array
N SDCNT
;
K XQORNOD
K ^TMP("SCENI",$J) ; Sorting global
K ^TMP("SCEN LM",$J) ; LM Display global
K ^TMP("SCENIDX",$J) ; Index for expand encounter
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("ENCOUNTER"),EC=$P(X,U,2),EW=$P(X,U,3)
S X=VALMDDF("SSN"),SC=$P(X,U,2),SW=$P(X,U,3)
S X=VALMDDF("PATIENT"),PC=$P(X,U,2),PW=$P(X,U,3)
S X=VALMDDF("DELETED"),DC=$P(X,U,2),DW=$P(X,U,3)
;
D BLD,BLDLM
I '$D(^TMP("SCENI",$J)) D
. S (SDCNT,VALMCNT)=0
. D SET(" "),SET(" No Incomplete Encounters found.")
Q
;
BLD ; Order through the Xmited OE Error file on encounter Xref
; Variables
; SDOEDT - Encounter date
; SDOE - Pointer to #409.68
; SDE - End date of date range
; SDCNT - Count of entries
; SDXMT - Pointer to #409.73
; SDXER - Pointer to #409.75
;
N SDOEDT,SDOE,SDE,SDCNT,SDXMT,SDXER
;
Q:'$D(SDDT)
S SDOEDT=$P(SDDT,U)-.1,SDE=$P(SDDT,U,2)+.9,(SDCNT,VALMCNT)=0
I SDENTYP["P" D PLKUP(SDFN) Q
I SDENTYP["C" D CLKUP($O(VAUTC(0))) Q
;the remaining is for a error code look up
F S SDOEDT=$O(^SD(409.75,"AEDT",SDOEDT)) Q:'SDOEDT!(SDOEDT>SDE) D
. S SDXMT=0 F S SDXMT=$O(^SD(409.75,"AEDT",SDOEDT,SDXMT)) Q:'SDXMT D
.. S SDXER=0 F S SDXER=$O(^SD(409.75,"AEDT",SDOEDT,SDXMT,SDXER)) Q:'SDXER I $D(^SD(409.75,SDXER,0)) D:$P(^SD(409.75,SDXER,0),U,2)=SDEVAL BLDA(SDXMT,SDOEDT)
Q
;
BLDA(SDXMT,SDOEDT) ; Build list entry, and retreive encounter information
; Input
; SDXMT - Pointer to $409.73
; SDOEDT - Date of encounter
;
; Out
; ^TMP("SCEN LM",$J,Patient Name,Encounter Date,Xmt Ptr)=DFN^BID^Delete marker ('*')
;
N DFN
;
Q:'SDOEDT
S SDCNT=SDCNT+1,SDDEL=""
S SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
;
S:SCSTAT=1 SDDEL="*"
I SCSTAT<0 Q
;
S SDNAME=$$LOWER^VALM1($P(^DPT(SCINF("DFN"),0),U))
S DFN=SCINF("DFN")
D PID^VADPT6
S ^TMP("SCEN LM",$J,SDNAME,SDOEDT,SDXMT)=SCINF("DFN")_U_VA("BID")_U_$G(SDDEL)
K SDDEL
Q
;
BLDLM ; Build display list array for LM
; Variables
; SDN - Patient Name
; SDD - Encounter Date
; SDXT - Pointer to #409.73, transmission pointer
;
S SDCNT=0
S SDN="" F S SDN=$O(^TMP("SCEN LM",$J,SDN)) Q:SDN']"" D
. S SDD="" F S SDD=$O(^TMP("SCEN LM",$J,SDN,SDD)) Q:'SDD D
.. S SDXT="" F S SDXT=$O(^TMP("SCEN LM",$J,SDN,SDD,SDXT)) Q:'SDXT D BLDLM1(SDXT)
Q
;
BLDLM1(SDXT) ; Build LM Display line
; Input
; SDXT - DFN^BID^Delete marker ('*')
;
K SDX
S SDCNT=SDCNT+1,SDX="",$P(SDX," ",VALMWD+1)=""
S SDX=$E(SDX,1,IC-1)_$E(SDCNT_BL,1,IW)_$E(SDX,IC+IW+1,VALMWD)
S SDX=$E(SDX,1,DC-1)_$E($P(^TMP("SCEN LM",$J,SDN,SDD,SDXT),U,3)_BL,1,DW)_$E(SDX,DC+DW+1,VALMWD)
S SDX=$E(SDX,1,PC-1)_$E(SDN_BL,1,PW)_$E(SDX,PC+PW+1,VALMWD)
S SDX=$E(SDX,1,SC-1)_$E($P(^TMP("SCEN LM",$J,SDN,SDD,SDXT),U,2)_BL,1,SW)_$E(SDX,SC+SW+1,VALMWD)
S SDX=$E(SDX,1,EC-1)_$E($$FMTE^XLFDT(SDD,1)_BL,1,EW)_$E(SDX,EC+EW+1,VALMWD)
D SET(SDX,SDXT)
Q
;
SET(X,SDXMT) ;
N SCEN
;
S VALMCNT=VALMCNT+1,^TMP("SCENI",$J,VALMCNT,0)=X
Q:'SDCNT
S ^TMP("SCENI",$J,"IDX",VALMCNT,SDCNT)=""
S ^TMP("SCENI",$J,SDCNT,0)=X
S ^TMP("SCENI",$J,"XMT",SDCNT,SDXMT)=""
;
I $$OPENC^SCUTIE1(SDXMT,"SCEN")>-1 D
. S ^TMP("SCENIDX",$J,SDCNT)=VALMCNT_U_SCEN("DFN")_U_SCEN("ENCOUNTER")_U_SCEN("CLINIC")
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2) G EX1
K ^TMP("SCENI",$J),^TMP("SCEN LM",$J),^TMP("SCENIDX",$J),^TMP("SCENI TMP",$J)
I '$G(FLG1) K ^TMP("SDAMIDX",$J)
K VA,SDCLN,SDIV,SDENDDT1,SDNR,SDPRDIV,ANS,DFN,EC,EW,IC,IW,PC,PW,SC,SW,SDX,DC,DW,SDNAME,SDFN,VAUTINI,SDCNT,DIC,BL
K SDOK,SCINF,RTN,SCSTAT,SCEN,RESULT,SCTEXT,LINE,SDDEL,SDD,SDN,SDXT,SDBDT,SDCL,SDDA,SDOEDT,SDOEL,SDVIEN,SDXMT
K VALMDDF
D FULL^VALM1
D CLEAN^VALM10
EX1 Q
;
PLKUP(SDFN) ;
;This is the lookup by patient.
;SDFN is the DFN of the patient.
;
N COD,SDXER
S COD=""
F S COD=$O(^SD(409.75,"ACOD",SDFN,COD)) Q:COD="" S SDXER=0 F S SDXER=$O(^SD(409.75,"ACOD",SDFN,COD,SDXER)) Q:SDXER="" DO
.N NODE,ANS
.S NODE=$G(^SD(409.75,SDXER,0)) I NODE=""!($P(NODE,U,1)'>0) Q
.S ANS=$$CHKDATE($P(NODE,U,1),SDOEDT,SDE)
.I ANS D BLDA($P(NODE,U,1),$P(ANS,U,2))
.Q
Q
;
CLKUP(SDCLN) ;
;
;This is the lookup by clinic.
;SDCLN is the IEN of the clinic
;
N SDXER,XMIT,ANS
S SDXER=0
F S SDXER=$O(^SD(409.75,"AECL",SDCLN,SDXER)) Q:SDXER="" S XMIT=$P($G(^SD(409.75,SDXER,0)),U,1) I XMIT]"" S ANS=$$CHKDATE(XMIT,SDOEDT,SDE) I ANS D BLDA(XMIT,$P(ANS,U,2))
Q
;
CHKDATE(XMIT,BDT,EDT) ;
;this function call ensures that the date of the encounter is within
;the parameters.
;
;XMIT - IEN of 409.73
;BDT - the beginning date
;EDT - the ending date
;
N ANS
S XMIT=$G(^SD(409.73,XMIT,0))
I XMIT="" S ANS=0 G CHKQ
I $P(XMIT,U,2)]"" S DATE=$P($G(^SCE($P(XMIT,U,2),0)),U,1)
I $P(XMIT,U,3)]"" S DATE=$P($G(^SD(409.74,$P(XMIT,U,3),0)),U,1)
I (DATE<BDT)!(DATE>EDT) S ANS=0
E S ANS="1^"_DATE
CHKQ Q ANS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCENI0 7262 printed Nov 22, 2024@17:49:41 Page 2
SCENI0 ;ALB/SCK - INCOMPLETE ENCOUNTER MGMT MAIN LM DISPLAY ; 07-MAY-1997
+1 ;;5.3;Scheduling;**66**;AUG 13, 1993
+2 ;
EN ; Entry point for IEMM LM display
+1 ; Variables
+2 ; VAUTC,VAUTD - Clinic and Division o/m/a arrays
+3 ; SDENTYP - Search type, P:patient, C:Clinic, E:Error Code
+4 ; SDCLN - Clinic from selection lookup
+5 ; SDDT - Date range for search, Begin^End format
+6 ; SDY - Local variable used in selection criteria
+7 ; SDEVAL - Error code value
+8 ; SDFN - Patient DFN for local use
+9 ; SDIEMM - Flag for IEMM
+10 ;
+11 NEW SDENTYP,DFN,SDCLN,SDDT,VAUTC,VAUTD,SDY,SDEVAL,SDFN,SDIEMM
+12 KILL X,SDB,XQORNOD,DA,DR,DIE,%B
+13 ;
AGN if '$$ENTRY^SCUTIE2(.SDY)
QUIT
+1 IF $GET(SDENTYP)']""
GOTO AGN
+2 ;
+3 IF SDENTYP["P"
Begin DoDot:1
+4 SET SDFN=+SDY
+5 SET VAUTC=1
+6 SET X=$PIECE($GET(^DG(43,1,"SCLR")),U,12)
+7 SET SDDT=$$FMADD^XLFDT($$DT^XLFDT,-X)_U_$$DT^XLFDT
End DoDot:1
+8 ;
+9 IF SDENTYP["C"
Begin DoDot:1
+10 SET SDCLN=+SDY
+11 SET VAUTC=0
SET VAUTC(+SDY)=$PIECE(^SC(+SDY,0),U)
End DoDot:1
if '$$ASKDT^SCENI01(.SDDT)
GOTO ENQ
+12 ;
+13 IF SDENTYP["E"
Begin DoDot:1
+14 SET VAUTC=1
+15 SET SDEVAL=+SDY
End DoDot:1
if '$$ASKDT^SCENI01(.SDDT)
GOTO ENQ
+16 ;
+17 SET VAUTD=1
EN1 DO WAIT^DICD
+1 IF $GET(FLG1)
KILL XQORS,VALMEVL
+2 SET SDIEMM=1
+3 DO EN^VALM("SCENI INCOMPLETE ENC MGT")
ENQ QUIT
+1 ;
ENP(SDXPTR) ; Entry point for Data validation, Patient Predefined
+1 ; This entry point will jump to the second LM screen and display any
+2 ; errors for the encounter.
+3 ;
+4 ; Input
+5 ; SDXMT - Pointer to transmission file, 409.73
+6 ;
+7 ; Variables
+8 ; FLG1 - Flag for patient defined entry point
+9 ;
+10 NEW FLG1,SDIEMM
+11 SET SDIEMM=1
+12 ;S VALMBCK="R"
+13 SET FLG1=1
+14 DO EN^SCENIA0
+15 QUIT
+16 ;
HDR ; -- header code
+1 NEW SDCLN
+2 ;
+3 SET VALMHDR(1)="Date Range: "_$$FDATE^VALM1($PIECE(SDDT,U))_" thru "_$$FDATE^VALM1($PIECE(SDDT,U,2))
+4 ;
+5 IF SDENTYP["P"
Begin DoDot:1
+6 SET VALMHDR(2)=" Patient: "_$PIECE(^DPT(SDFN,0),U)
End DoDot:1
+7 IF SDENTYP["C"
Begin DoDot:1
+8 SET SDCLN=$ORDER(VAUTC(0))
+9 SET VALMHDR(2)=" Clinic: "_$EXTRACT(VAUTC(SDCLN),1,25)
End DoDot:1
+10 IF SDENTYP["E"
Begin DoDot:1
+11 SET VALMHDR(2)="Error Code: "_$EXTRACT($PIECE(^SD(409.76,SDEVAL,1),U),1,60)
End DoDot:1
+12 SET VALMSG="'*' Deleted Encounter Enter ?? for more actions"
+13 QUIT
+14 ;
INIT ; -- init variables and list array
+1 NEW SDCNT
+2 ;
+3 KILL XQORNOD
+4 ; Sorting global
KILL ^TMP("SCENI",$JOB)
+5 ; LM Display global
KILL ^TMP("SCEN LM",$JOB)
+6 ; Index for expand encounter
KILL ^TMP("SCENIDX",$JOB)
+7 DO CLEAN^VALM10
+8 ;
+9 SET BL=""
SET $PIECE(BL," ",30)=""
+10 SET X=VALMDDF("INDEX")
SET IC=$PIECE(X,U,2)
SET IW=$PIECE(X,U,3)
+11 SET X=VALMDDF("ENCOUNTER")
SET EC=$PIECE(X,U,2)
SET EW=$PIECE(X,U,3)
+12 SET X=VALMDDF("SSN")
SET SC=$PIECE(X,U,2)
SET SW=$PIECE(X,U,3)
+13 SET X=VALMDDF("PATIENT")
SET PC=$PIECE(X,U,2)
SET PW=$PIECE(X,U,3)
+14 SET X=VALMDDF("DELETED")
SET DC=$PIECE(X,U,2)
SET DW=$PIECE(X,U,3)
+15 ;
+16 DO BLD
DO BLDLM
+17 IF '$DATA(^TMP("SCENI",$JOB))
Begin DoDot:1
+18 SET (SDCNT,VALMCNT)=0
+19 DO SET(" ")
DO SET(" No Incomplete Encounters found.")
End DoDot:1
+20 QUIT
+21 ;
BLD ; Order through the Xmited OE Error file on encounter Xref
+1 ; Variables
+2 ; SDOEDT - Encounter date
+3 ; SDOE - Pointer to #409.68
+4 ; SDE - End date of date range
+5 ; SDCNT - Count of entries
+6 ; SDXMT - Pointer to #409.73
+7 ; SDXER - Pointer to #409.75
+8 ;
+9 NEW SDOEDT,SDOE,SDE,SDCNT,SDXMT,SDXER
+10 ;
+11 if '$DATA(SDDT)
QUIT
+12 SET SDOEDT=$PIECE(SDDT,U)-.1
SET SDE=$PIECE(SDDT,U,2)+.9
SET (SDCNT,VALMCNT)=0
+13 IF SDENTYP["P"
DO PLKUP(SDFN)
QUIT
+14 IF SDENTYP["C"
DO CLKUP($ORDER(VAUTC(0)))
QUIT
+15 ;the remaining is for a error code look up
+16 FOR
SET SDOEDT=$ORDER(^SD(409.75,"AEDT",SDOEDT))
if 'SDOEDT!(SDOEDT>SDE)
QUIT
Begin DoDot:1
+17 SET SDXMT=0
FOR
SET SDXMT=$ORDER(^SD(409.75,"AEDT",SDOEDT,SDXMT))
if 'SDXMT
QUIT
Begin DoDot:2
+18 SET SDXER=0
FOR
SET SDXER=$ORDER(^SD(409.75,"AEDT",SDOEDT,SDXMT,SDXER))
if 'SDXER
QUIT
IF $DATA(^SD(409.75,SDXER,0))
if $PIECE(^SD(409.75,SDXER,0),U,2)=SDEVAL
DO BLDA(SDXMT,SDOEDT)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
BLDA(SDXMT,SDOEDT) ; Build list entry, and retreive encounter information
+1 ; Input
+2 ; SDXMT - Pointer to $409.73
+3 ; SDOEDT - Date of encounter
+4 ;
+5 ; Out
+6 ; ^TMP("SCEN LM",$J,Patient Name,Encounter Date,Xmt Ptr)=DFN^BID^Delete marker ('*')
+7 ;
+8 NEW DFN
+9 ;
+10 if 'SDOEDT
QUIT
+11 SET SDCNT=SDCNT+1
SET SDDEL=""
+12 SET SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
+13 ;
+14 if SCSTAT=1
SET SDDEL="*"
+15 IF SCSTAT<0
QUIT
+16 ;
+17 SET SDNAME=$$LOWER^VALM1($PIECE(^DPT(SCINF("DFN"),0),U))
+18 SET DFN=SCINF("DFN")
+19 DO PID^VADPT6
+20 SET ^TMP("SCEN LM",$JOB,SDNAME,SDOEDT,SDXMT)=SCINF("DFN")_U_VA("BID")_U_$GET(SDDEL)
+21 KILL SDDEL
+22 QUIT
+23 ;
BLDLM ; Build display list array for LM
+1 ; Variables
+2 ; SDN - Patient Name
+3 ; SDD - Encounter Date
+4 ; SDXT - Pointer to #409.73, transmission pointer
+5 ;
+6 SET SDCNT=0
+7 SET SDN=""
FOR
SET SDN=$ORDER(^TMP("SCEN LM",$JOB,SDN))
if SDN']""
QUIT
Begin DoDot:1
+8 SET SDD=""
FOR
SET SDD=$ORDER(^TMP("SCEN LM",$JOB,SDN,SDD))
if 'SDD
QUIT
Begin DoDot:2
+9 SET SDXT=""
FOR
SET SDXT=$ORDER(^TMP("SCEN LM",$JOB,SDN,SDD,SDXT))
if 'SDXT
QUIT
DO BLDLM1(SDXT)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
BLDLM1(SDXT) ; Build LM Display line
+1 ; Input
+2 ; SDXT - DFN^BID^Delete marker ('*')
+3 ;
+4 KILL SDX
+5 SET SDCNT=SDCNT+1
SET SDX=""
SET $PIECE(SDX," ",VALMWD+1)=""
+6 SET SDX=$EXTRACT(SDX,1,IC-1)_$EXTRACT(SDCNT_BL,1,IW)_$EXTRACT(SDX,IC+IW+1,VALMWD)
+7 SET SDX=$EXTRACT(SDX,1,DC-1)_$EXTRACT($PIECE(^TMP("SCEN LM",$JOB,SDN,SDD,SDXT),U,3)_BL,1,DW)_$EXTRACT(SDX,DC+DW+1,VALMWD)
+8 SET SDX=$EXTRACT(SDX,1,PC-1)_$EXTRACT(SDN_BL,1,PW)_$EXTRACT(SDX,PC+PW+1,VALMWD)
+9 SET SDX=$EXTRACT(SDX,1,SC-1)_$EXTRACT($PIECE(^TMP("SCEN LM",$JOB,SDN,SDD,SDXT),U,2)_BL,1,SW)_$EXTRACT(SDX,SC+SW+1,VALMWD)
+10 SET SDX=$EXTRACT(SDX,1,EC-1)_$EXTRACT($$FMTE^XLFDT(SDD,1)_BL,1,EW)_$EXTRACT(SDX,EC+EW+1,VALMWD)
+11 DO SET(SDX,SDXT)
+12 QUIT
+13 ;
SET(X,SDXMT) ;
+1 NEW SCEN
+2 ;
+3 SET VALMCNT=VALMCNT+1
SET ^TMP("SCENI",$JOB,VALMCNT,0)=X
+4 if 'SDCNT
QUIT
+5 SET ^TMP("SCENI",$JOB,"IDX",VALMCNT,SDCNT)=""
+6 SET ^TMP("SCENI",$JOB,SDCNT,0)=X
+7 SET ^TMP("SCENI",$JOB,"XMT",SDCNT,SDXMT)=""
+8 ;
+9 IF $$OPENC^SCUTIE1(SDXMT,"SCEN")>-1
Begin DoDot:1
+10 SET ^TMP("SCENIDX",$JOB,SDCNT)=VALMCNT_U_SCEN("DFN")_U_SCEN("ENCOUNTER")_U_SCEN("CLINIC")
End DoDot:1
+11 QUIT
+12 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
GOTO EX1
+2 KILL ^TMP("SCENI",$JOB),^TMP("SCEN LM",$JOB),^TMP("SCENIDX",$JOB),^TMP("SCENI TMP",$JOB)
+3 IF '$GET(FLG1)
KILL ^TMP("SDAMIDX",$JOB)
+4 KILL VA,SDCLN,SDIV,SDENDDT1,SDNR,SDPRDIV,ANS,DFN,EC,EW,IC,IW,PC,PW,SC,SW,SDX,DC,DW,SDNAME,SDFN,VAUTINI,SDCNT,DIC,BL
+5 KILL SDOK,SCINF,RTN,SCSTAT,SCEN,RESULT,SCTEXT,LINE,SDDEL,SDD,SDN,SDXT,SDBDT,SDCL,SDDA,SDOEDT,SDOEL,SDVIEN,SDXMT
+6 KILL VALMDDF
+7 DO FULL^VALM1
+8 DO CLEAN^VALM10
EX1 QUIT
+1 ;
PLKUP(SDFN) ;
+1 ;This is the lookup by patient.
+2 ;SDFN is the DFN of the patient.
+3 ;
+4 NEW COD,SDXER
+5 SET COD=""
+6 FOR
SET COD=$ORDER(^SD(409.75,"ACOD",SDFN,COD))
if COD=""
QUIT
SET SDXER=0
FOR
SET SDXER=$ORDER(^SD(409.75,"ACOD",SDFN,COD,SDXER))
if SDXER=""
QUIT
Begin DoDot:1
+7 NEW NODE,ANS
+8 SET NODE=$GET(^SD(409.75,SDXER,0))
IF NODE=""!($PIECE(NODE,U,1)'>0)
QUIT
+9 SET ANS=$$CHKDATE($PIECE(NODE,U,1),SDOEDT,SDE)
+10 IF ANS
DO BLDA($PIECE(NODE,U,1),$PIECE(ANS,U,2))
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
CLKUP(SDCLN) ;
+1 ;
+2 ;This is the lookup by clinic.
+3 ;SDCLN is the IEN of the clinic
+4 ;
+5 NEW SDXER,XMIT,ANS
+6 SET SDXER=0
+7 FOR
SET SDXER=$ORDER(^SD(409.75,"AECL",SDCLN,SDXER))
if SDXER=""
QUIT
SET XMIT=$PIECE($GET(^SD(409.75,SDXER,0)),U,1)
IF XMIT]""
SET ANS=$$CHKDATE(XMIT,SDOEDT,SDE)
IF ANS
DO BLDA(XMIT,$PIECE(ANS,U,2))
+8 QUIT
+9 ;
CHKDATE(XMIT,BDT,EDT) ;
+1 ;this function call ensures that the date of the encounter is within
+2 ;the parameters.
+3 ;
+4 ;XMIT - IEN of 409.73
+5 ;BDT - the beginning date
+6 ;EDT - the ending date
+7 ;
+8 NEW ANS
+9 SET XMIT=$GET(^SD(409.73,XMIT,0))
+10 IF XMIT=""
SET ANS=0
GOTO CHKQ
+11 IF $PIECE(XMIT,U,2)]""
SET DATE=$PIECE($GET(^SCE($PIECE(XMIT,U,2),0)),U,1)
+12 IF $PIECE(XMIT,U,3)]""
SET DATE=$PIECE($GET(^SD(409.74,$PIECE(XMIT,U,3),0)),U,1)
+13 IF (DATE<BDT)!(DATE>EDT)
SET ANS=0
+14 IF '$TEST
SET ANS="1^"_DATE
CHKQ QUIT ANS
