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 ---[H[J[2J[HSCMCU1 1048 printed Oct 16, 2024@18:42:19 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
