- 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 Jan 18, 2025@03:42:51 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