SCMCU1.m

SCMCU1 ;ALB/CMM - Team Information Display ;7/25/99  18:46

 ;;5.3;Scheduling;**41,177**;AUG 13, 1993

 ;

 ;action on Appointment Management

 ;

SEL ;selection - getting patient

 N ENT

 I '$D(@VALMAR@("IDX")) S TDFN=$$GETPT() Q

 ; ^ no selections available, prompt for patient?

 D EN^VALM2(XQORNOD(0),"S")

 S ENT=$O(VALMY(0))

 I ENT="" S TDFN=$$GETPT() Q

 I '$D(^TMP("SDAMIDX",$J,ENT)) S TDFN=0 Q

 S TDFN=+$P($G(^TMP("SDAMIDX",$J,ENT)),"^",2)

 Q

 ;

GETPT() ;function to get patient

 I $G(VALMHDR(1))?.E1"Patient:".E Q SDFN

 N TDFN

 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient: "

 D ^DIC

 K DIC

 I X=""!(X["^")!(+Y<0) S TDFN=0

 S TDFN=+Y

 Q TDFN

 ;

INIT ;gather team data

 N GBL

 I TDFN=0 S VALMQUIT="" Q

 S GBL="^TMP(""SCTI"","_$J_")"

 K @GBL

 S SDLN=1

 D CNTRL^VALM10(SDLN,15,45,IOINHI,IOINORM)

 D TDATA^SDPPTEM(TDFN,.VALMCNT)

 Q

 ;

HDR ;header code

 N PTNAME

 S PTNAME=$P($G(^DPT(TDFN,0)),"^")

 S VALMHDR(2)="Patient: "_PTNAME_"     SSN: "_$P($G(^DPT(TDFN,0)),U,9)

 S VALMPGE=1 ;start at page 1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCMCU1   1048     printed  Apr 09, 2024@21:54:24                                                                                                                                                                                                      Page 2

SCMCU1    ;ALB/CMM - Team Information Display ;7/25/99  18:46

 +1       ;;5.3;Scheduling;**41,177**;AUG 13, 1993

 +2       ;

 +3       ;action on Appointment Management

 +4       ;

SEL       ;selection - getting patient

 +1        NEW ENT

 +2        IF '$DATA(@VALMAR@("IDX"))

               SET TDFN=$$GETPT()

               QUIT 

 +3       ; ^ no selections available, prompt for patient?

 +4        DO EN^VALM2(XQORNOD(0),"S")

 +5        SET ENT=$ORDER(VALMY(0))

 +6        IF ENT=""

               SET TDFN=$$GETPT()

               QUIT 

 +7        IF '$DATA(^TMP("SDAMIDX",$JOB,ENT))

               SET TDFN=0

               QUIT 

 +8        SET TDFN=+$PIECE($GET(^TMP("SDAMIDX",$JOB,ENT)),"^",2)

 +9        QUIT 

 +10      ;

GETPT()   ;function to get patient

 +1        IF $GET(VALMHDR(1))?.E1"Patient:".E

               QUIT SDFN

 +2        NEW TDFN

 +3        SET DIC="^DPT("

           SET DIC(0)="AEQM"

           SET DIC("A")="Select Patient: "

 +4        DO ^DIC

 +5        KILL DIC

 +6        IF X=""!(X["^")!(+Y<0)

               SET TDFN=0

 +7        SET TDFN=+Y

 +8        QUIT TDFN

 +9       ;

INIT      ;gather team data

 +1        NEW GBL

 +2        IF TDFN=0

               SET VALMQUIT=""

               QUIT 

 +3        SET GBL="^TMP(""SCTI"","_$JOB_")"

 +4        KILL @GBL

 +5        SET SDLN=1

 +6        DO CNTRL^VALM10(SDLN,15,45,IOINHI,IOINORM)

 +7        DO TDATA^SDPPTEM(TDFN,.VALMCNT)

 +8        QUIT 

 +9       ;

HDR       ;header code

 +1        NEW PTNAME

 +2        SET PTNAME=$PIECE($GET(^DPT(TDFN,0)),"^")

 +3        SET VALMHDR(2)="Patient: "_PTNAME_"     SSN: "_$PIECE($GET(^DPT(TDFN,0)),U,9)

 +4       ;start at page 1

           SET VALMPGE=1

 +5        QUIT