- 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 Feb 19, 2025@00:26:07 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
