SDPP.m

SDPP ;ALB/CAW - Patient Profile - Main ; 20 Oct 98 11:15 PM

 ;;5.3;Scheduling;**2,6,132,163,1015**;Aug 13, 1993;Build 21

 ;

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

SDPP      ;ALB/CAW - Patient Profile - Main ; 20 Oct 98 11:15 PM

 +1       ;;5.3;Scheduling;**2,6,132,163,1015**;Aug 13, 1993;Build 21

 +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