| 1 | SDPP ;ALB/CAW - Patient Profile - Main ; 20 Oct 98 11:15 PM
|
|---|
| 2 | ;;5.3;Scheduling;**2,6,132,163**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 5 | K ^TMP("SDPP",$J) N SDBD,SDED
|
|---|
| 6 | S VALMBCK=""
|
|---|
| 7 | W ! D EN^VALM("SDPP PATIENT PROFILE")
|
|---|
| 8 | S VALMBCK="R"
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | HDR ; Header
|
|---|
| 12 | N VA,VAERR
|
|---|
| 13 | Q:'$D(DFN)
|
|---|
| 14 | D PID^VADPT
|
|---|
| 15 | 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")
|
|---|
| 16 | S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
|
|---|
| 17 | S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$L(X),$L(X))
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | INIT ; Gather generic patient info
|
|---|
| 21 | D QUIT1 S (SDLN,SDERR,SDPRINT)=0
|
|---|
| 22 | S DIC=2,DIC(0)="AEMQ" D ^DIC K DIC S:Y<0 VALMQUIT="" G:Y<0 INITQ S DFN=+Y
|
|---|
| 23 | D DIR I SDERR S VALMQUIT="" G INITQ
|
|---|
| 24 | I 'SDRANGE S (SDBD,SDBEG)=2800101,(SDED,SDEND)=$$ENDDT() S SDHDR=1 G INIT0
|
|---|
| 25 | S SDT00="AEX" D DATE^SDUTL I '$D(SDED) S VALMQUIT="",SDERR=1 G INITQ
|
|---|
| 26 | S SDED=SDED_.24
|
|---|
| 27 | INIT0 D DIR1 I SDERR S VALMQUIT="" G INITQ
|
|---|
| 28 | I SDYES S SDPRINT=1 D ^SDPPRT S VALMQUIT="" K:'$D(VALMHDR(1)) ^TMP("SDPP",$J) D QUIT1 G INIT
|
|---|
| 29 | ;
|
|---|
| 30 | INIT1 N VA,VAERR K VALMQUIT
|
|---|
| 31 | D PID^VADPT
|
|---|
| 32 | S (SDERR,SDLN)=0 D ^SDPPAT1 ; Generic Patient Information
|
|---|
| 33 | S VALMCNT=SDLN
|
|---|
| 34 | INITQ Q
|
|---|
| 35 | ;
|
|---|
| 36 | ENDDT() ;Calculate end date for "all" dates
|
|---|
| 37 | N X S X=$O(^DPT(DFN,"S",""),-1) S:X<DT X=DT_.24 Q X
|
|---|
| 38 | ;
|
|---|
| 39 | QUIT ;
|
|---|
| 40 | K BEGDATE,CNT,DFN,SDCDATA,SDOPE,SDHDR,VA,VAERR,VALMBCK,VALMESC,^TMP("SDPP",$J),^TMP("SDPPALL",$J),^TMP("SD",$J) D KILL^%ZISS
|
|---|
| 41 | 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
|
|---|
| 42 | Q
|
|---|
| 43 | CHPT ; Change Patient within Patient Profile
|
|---|
| 44 | S DIC=2,DIC(0)="AEMQ" D ^DIC K DIC I Y<0 W !,"Patient has not been changed." S VALMBCK="R" Q
|
|---|
| 45 | K ^TMP("SDPP",$J) S DFN=+Y,SDLN=0
|
|---|
| 46 | CHDT K:$G(SDEND)'=9999999 SDHDR D INIT1,HDR S VALMBCK="R"
|
|---|
| 47 | Q
|
|---|
| 48 | DIR ; DIR call
|
|---|
| 49 | S (SDYES,SDRANGE)=0,DIR("B")="All" K SDHDR
|
|---|
| 50 | S DIR(0)="S^R:Range;A:All",DIR("A")="Do you want a (R)ange or (A)ll"
|
|---|
| 51 | S DIR("?",1)="",DIR("?",2)=" (A)ll gives the user all dates.",DIR("?")=" (R)ange allows the user to select a range of dates."
|
|---|
| 52 | D ^DIR K DIR I $D(DIRUT) S SDERR=1 G DIRQ
|
|---|
| 53 | I "RA"'[Y W !!,"Enter 'R' for a date range or 'A' for all dates." G DIR
|
|---|
| 54 | I "R"[Y S SDRANGE=1
|
|---|
| 55 | Q
|
|---|
| 56 | DIR1 ;
|
|---|
| 57 | S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print the profile"
|
|---|
| 58 | S DIR("?",1)=" Enter 'YES' to print the profile.",DIR("?")=" If you enter 'NO', it will take you to the Patient Profile screens."
|
|---|
| 59 | D ^DIR K DIR I $D(DIRUT) S SDERR=1 G DIRQ
|
|---|
| 60 | I Y S SDYES=1
|
|---|
| 61 | DIRQ Q
|
|---|
