SDPP ;ALB/CAW - Patient Profile - Main ; 20 Oct 98 11:15 PM
;;5.3;Scheduling;**2,6,132,163**;Aug 13, 1993
;
EN ;
K ^TMP("SDPP",$J) N SDBD,SDED
S VALMBCK=""
W ! D EN^VALM("SDPP PATIENT PROFILE")
S VALMBCK="R"
Q
;
HDR ; Header
N VA,VAERR
Q:'$D(DFN)
D PID^VADPT
S VALMHDR(1)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" "_$S('$G(SDHDR):$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED),1:"All Dates")
S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$L(X),$L(X))
Q
;
INIT ; Gather generic patient info
D QUIT1 S (SDLN,SDERR,SDPRINT)=0
S DIC=2,DIC(0)="AEMQ" D ^DIC K DIC S:Y<0 VALMQUIT="" G:Y<0 INITQ S DFN=+Y
D DIR I SDERR S VALMQUIT="" G INITQ
I 'SDRANGE S (SDBD,SDBEG)=2800101,(SDED,SDEND)=$$ENDDT() S SDHDR=1 G INIT0
S SDT00="AEX" D DATE^SDUTL I '$D(SDED) S VALMQUIT="",SDERR=1 G INITQ
S SDED=SDED_.24
INIT0 D DIR1 I SDERR S VALMQUIT="" G INITQ
I SDYES S SDPRINT=1 D ^SDPPRT S VALMQUIT="" K:'$D(VALMHDR(1)) ^TMP("SDPP",$J) D QUIT1 G INIT
;
INIT1 N VA,VAERR K VALMQUIT
D PID^VADPT
S (SDERR,SDLN)=0 D ^SDPPAT1 ; Generic Patient Information
S VALMCNT=SDLN
INITQ Q
;
ENDDT() ;Calculate end date for "all" dates
N X S X=$O(^DPT(DFN,"S",""),-1) S:X<DT X=DT_.24 Q X
;
QUIT ;
K BEGDATE,CNT,DFN,SDCDATA,SDOPE,SDHDR,VA,VAERR,VALMBCK,VALMESC,^TMP("SDPP",$J),^TMP("SDPPALL",$J),^TMP("SD",$J) D KILL^%ZISS
QUIT1 K ENDDATE,ROU,SD,SDACT,SDADD,SDCT,SDCNT,SDASH,SDBD,SDBEG,SDED,SDEND,SDERR,SDDIS,SDDT,SDELIG,SDFST,SDFSTCOL,SDLEN,SDLN,SDLN1,SDPAGE,SDRANGE,SDSEC,SDSECCOL,SDLN,SDDEP,SDPRINT,SDRANGE,SDWHERE,SDYES,SDX
Q
CHPT ; Change Patient within Patient Profile
S DIC=2,DIC(0)="AEMQ" D ^DIC K DIC I Y<0 W !,"Patient has not been changed." S VALMBCK="R" Q
K ^TMP("SDPP",$J) S DFN=+Y,SDLN=0
CHDT K:$G(SDEND)'=9999999 SDHDR D INIT1,HDR S VALMBCK="R"
Q
DIR ; DIR call
S (SDYES,SDRANGE)=0,DIR("B")="All" K SDHDR
S DIR(0)="S^R:Range;A:All",DIR("A")="Do you want a (R)ange or (A)ll"
S DIR("?",1)="",DIR("?",2)=" (A)ll gives the user all dates.",DIR("?")=" (R)ange allows the user to select a range of dates."
D ^DIR K DIR I $D(DIRUT) S SDERR=1 G DIRQ
I "RA"'[Y W !!,"Enter 'R' for a date range or 'A' for all dates." G DIR
I "R"[Y S SDRANGE=1
Q
DIR1 ;
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print the profile"
S DIR("?",1)=" Enter 'YES' to print the profile.",DIR("?")=" If you enter 'NO', it will take you to the Patient Profile screens."
D ^DIR K DIR I $D(DIRUT) S SDERR=1 G DIRQ
I Y S SDYES=1
DIRQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPP 2593 printed Dec 13, 2024@02:59:37 Page 2
SDPP ;ALB/CAW - Patient Profile - Main ; 20 Oct 98 11:15 PM
+1 ;;5.3;Scheduling;**2,6,132,163**;Aug 13, 1993
+2 ;
EN ;
+1 KILL ^TMP("SDPP",$JOB)
NEW SDBD,SDED
+2 SET VALMBCK=""
+3 WRITE !
DO EN^VALM("SDPP PATIENT PROFILE")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
HDR ; Header
+1 NEW VA,VAERR
+2 if '$DATA(DFN)
QUIT
+3 DO PID^VADPT
+4 SET VALMHDR(1)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" "_$SELECT('$GET(SDHDR):$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED),1:"All Dates")
+5 SET X=$SELECT($DATA(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
+6 SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$LENGTH(X),$LENGTH(X))
+7 QUIT
+8 ;
INIT ; Gather generic patient info
+1 DO QUIT1
SET (SDLN,SDERR,SDPRINT)=0
+2 SET DIC=2
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
if Y<0
SET VALMQUIT=""
if Y<0
GOTO INITQ
SET DFN=+Y
+3 DO DIR
IF SDERR
SET VALMQUIT=""
GOTO INITQ
+4 IF 'SDRANGE
SET (SDBD,SDBEG)=2800101
SET (SDED,SDEND)=$$ENDDT()
SET SDHDR=1
GOTO INIT0
+5 SET SDT00="AEX"
DO DATE^SDUTL
IF '$DATA(SDED)
SET VALMQUIT=""
SET SDERR=1
GOTO INITQ
+6 SET SDED=SDED_.24
INIT0 DO DIR1
IF SDERR
SET VALMQUIT=""
GOTO INITQ
+1 IF SDYES
SET SDPRINT=1
DO ^SDPPRT
SET VALMQUIT=""
if '$DATA(VALMHDR(1))
KILL ^TMP("SDPP",$JOB)
DO QUIT1
GOTO INIT
+2 ;
INIT1 NEW VA,VAERR
KILL VALMQUIT
+1 DO PID^VADPT
+2 ; Generic Patient Information
SET (SDERR,SDLN)=0
DO ^SDPPAT1
+3 SET VALMCNT=SDLN
INITQ QUIT
+1 ;
ENDDT() ;Calculate end date for "all" dates
+1 NEW X
SET X=$ORDER(^DPT(DFN,"S",""),-1)
if X<DT
SET X=DT_.24
QUIT X
+2 ;
QUIT ;
+1 KILL BEGDATE,CNT,DFN,SDCDATA,SDOPE,SDHDR,VA,VAERR,VALMBCK,VALMESC,^TMP("SDPP",$JOB),^TMP("SDPPALL",$JOB),^TMP("SD",$JOB)
DO KILL^%ZISS
QUIT1 KILL ENDDATE,ROU,SD,SDACT,SDADD,SDCT,SDCNT,SDASH,SDBD,SDBEG,SDED,SDEND,SDERR,SDDIS,SDDT,SDELIG,SDFST,SDFSTCOL,SDLEN,SDLN,SDLN1,SDPAGE,SDRANGE,SDSEC,SDSECCOL,SDLN,SDDEP,SDPRINT,SDRANGE,SDWHERE,SDYES,SDX
+1 QUIT
CHPT ; Change Patient within Patient Profile
+1 SET DIC=2
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
IF Y<0
WRITE !,"Patient has not been changed."
SET VALMBCK="R"
QUIT
+2 KILL ^TMP("SDPP",$JOB)
SET DFN=+Y
SET SDLN=0
CHDT if $GET(SDEND)'=9999999
KILL SDHDR
DO INIT1
DO HDR
SET VALMBCK="R"
+1 QUIT
DIR ; DIR call
+1 SET (SDYES,SDRANGE)=0
SET DIR("B")="All"
KILL SDHDR
+2 SET DIR(0)="S^R:Range;A:All"
SET DIR("A")="Do you want a (R)ange or (A)ll"
+3 SET DIR("?",1)=""
SET DIR("?",2)=" (A)ll gives the user all dates."
SET DIR("?")=" (R)ange allows the user to select a range of dates."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET SDERR=1
GOTO DIRQ
+5 IF "RA"'[Y
WRITE !!,"Enter 'R' for a date range or 'A' for all dates."
GOTO DIR
+6 IF "R"[Y
SET SDRANGE=1
+7 QUIT
DIR1 ;
+1 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you want to print the profile"
+2 SET DIR("?",1)=" Enter 'YES' to print the profile."
SET DIR("?")=" If you enter 'NO', it will take you to the Patient Profile screens."
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET SDERR=1
GOTO DIRQ
+4 IF Y
SET SDYES=1
DIRQ QUIT
