SDPPALL ;ALB/CAW - Patient Profile - All ; 29 Jun 99 04:11PM
;;5.3;Scheduling;**6,41,177**;AUG 13, 1993
;
;
EN ;
K ^TMP("SDPPALL",$J)
S VALMBCK=""
W ! D WAIT^DICD,EN^VALM("SDPP PATIENT PROFILE ALL")
S VALMBCK="R"
Q
;
INIT ;
S SDLN=0,SDLN1=1,$P(SDASH,"-",IOM+1)=""
INIT1 I SDTYP=2!(SDTYP=6)!($D(SDTYP(2))) D
.D SET^SDPPAPP1(" *** Appointments ***") D:'SDPRINT CNTRL^VALM10(SDLN,25,20,IOINHI,IOINORM)
.D EN1^SDPPAPP1 ; Appointments
.I SDLN1=SDLN D SET^SDPPADD1(""),SET^SDPPADD1(" No appointments found.")
I SDTYP=1!(SDTYP=6)!($D(SDTYP(1))) D
.D SET^SDPPADD1(" *** Add/Edits ***") D:'SDPRINT CNTRL^VALM10(SDLN,27,17,IOINHI,IOINORM)
.S SDLN1=SDLN
.D EN1^SDPPADD1 ; Add/Edits
.I SDLN1=SDLN D SET^SDPPADD1(""),SET^SDPPADD1(" No add/edits found.")
I SDTYP=4!(SDTYP=6)!($D(SDTYP(4))) D
.D SET^SDPPENR1(" *** Enrollments ***") D:'SDPRINT CNTRL^VALM10(SDLN,26,19,IOINHI,IOINORM)
.S SDLN1=SDLN
.D EN1^SDPPENR1 ; Enrollments
.I SDLN1=SDLN D SET^SDPPENR1(""),SET^SDPPENR1(" No enrollments found.")
I SDTYP=5!(SDTYP=6)!($D(SDTYP(5))) D
.D SET^SDPPMT1(" *** Means Test Info ***") D:'SDPRINT CNTRL^VALM10(SDLN,23,23,IOINHI,IOINORM)
.S SDLN1=SDLN
.D EN1^SDPPMT1 ; Means test Info
.I SDLN1=SDLN D SET^SDPPMT1(""),SET^SDPPMT1(" No Means Test Info found.")
I SDTYP=3!(SDTYP=6)!($D(SDTYP(3))) D
.D SET^SDPPDIS1(" *** Dispositions ***") D:'SDPRINT CNTRL^VALM10(SDLN,25,20,IOINHI,IOINORM)
.S SDLN1=SDLN
.D EN1^SDPPDIS1 ; Dispositions
.I SDLN1=SDLN D SET^SDPPDIS1(""),SET^SDPPDIS1(" No dispositions found.")
I SDTYP=7!(SDTYP=6)!($D(SDTYP(7))) D
.D:'SDPRINT CNTRL^VALM10(SDLN,20,35,IOINHI,IOINORM)
.S SDLN1=SDLN
.D TDATA^SDPPTEM(DFN,.VALMCNT)
D:'SDPRINT HDR^SDPP
Q
;
QUIT ;
S VALMBCK="R"
K BEGDATE,ENDDATE,DIC,DGINC,DGINR,DGREL,SD,SDASH,SDATA,SDDT,SDFLG,SDFST,SDIFN,SDJ,SDL,SDLD,SDPR,SDSEC,X,SD1,SDACT,SDAP,SDBEN,SDBENE,SDCAR,SDCARE,SDLN1
K SDALL,SDCI,SDCL,SDDIS,SDFLN,SDLEN,SDLN,SDM,SDM1,SDMT,SDOB,SDPDATA,SDPOV,SDPV,SDSC,SDSEC,SDSTAT,SDAP,SDWHEN,SDSTATUS,SDVER,SDYN,SDOPT,SDACT,SDMT1,^TMP("SDPPALL",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPALL 2204 printed Oct 16, 2024@19:00:03 Page 2
SDPPALL ;ALB/CAW - Patient Profile - All ; 29 Jun 99 04:11PM
+1 ;;5.3;Scheduling;**6,41,177**;AUG 13, 1993
+2 ;
+3 ;
EN ;
+1 KILL ^TMP("SDPPALL",$JOB)
+2 SET VALMBCK=""
+3 WRITE !
DO WAIT^DICD
DO EN^VALM("SDPP PATIENT PROFILE ALL")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
INIT ;
+1 SET SDLN=0
SET SDLN1=1
SET $PIECE(SDASH,"-",IOM+1)=""
INIT1 IF SDTYP=2!(SDTYP=6)!($DATA(SDTYP(2)))
Begin DoDot:1
+1 DO SET^SDPPAPP1(" *** Appointments ***")
if 'SDPRINT
DO CNTRL^VALM10(SDLN,25,20,IOINHI,IOINORM)
+2 ; Appointments
DO EN1^SDPPAPP1
+3 IF SDLN1=SDLN
DO SET^SDPPADD1("")
DO SET^SDPPADD1(" No appointments found.")
End DoDot:1
+4 IF SDTYP=1!(SDTYP=6)!($DATA(SDTYP(1)))
Begin DoDot:1
+5 DO SET^SDPPADD1(" *** Add/Edits ***")
if 'SDPRINT
DO CNTRL^VALM10(SDLN,27,17,IOINHI,IOINORM)
+6 SET SDLN1=SDLN
+7 ; Add/Edits
DO EN1^SDPPADD1
+8 IF SDLN1=SDLN
DO SET^SDPPADD1("")
DO SET^SDPPADD1(" No add/edits found.")
End DoDot:1
+9 IF SDTYP=4!(SDTYP=6)!($DATA(SDTYP(4)))
Begin DoDot:1
+10 DO SET^SDPPENR1(" *** Enrollments ***")
if 'SDPRINT
DO CNTRL^VALM10(SDLN,26,19,IOINHI,IOINORM)
+11 SET SDLN1=SDLN
+12 ; Enrollments
DO EN1^SDPPENR1
+13 IF SDLN1=SDLN
DO SET^SDPPENR1("")
DO SET^SDPPENR1(" No enrollments found.")
End DoDot:1
+14 IF SDTYP=5!(SDTYP=6)!($DATA(SDTYP(5)))
Begin DoDot:1
+15 DO SET^SDPPMT1(" *** Means Test Info ***")
if 'SDPRINT
DO CNTRL^VALM10(SDLN,23,23,IOINHI,IOINORM)
+16 SET SDLN1=SDLN
+17 ; Means test Info
DO EN1^SDPPMT1
+18 IF SDLN1=SDLN
DO SET^SDPPMT1("")
DO SET^SDPPMT1(" No Means Test Info found.")
End DoDot:1
+19 IF SDTYP=3!(SDTYP=6)!($DATA(SDTYP(3)))
Begin DoDot:1
+20 DO SET^SDPPDIS1(" *** Dispositions ***")
if 'SDPRINT
DO CNTRL^VALM10(SDLN,25,20,IOINHI,IOINORM)
+21 SET SDLN1=SDLN
+22 ; Dispositions
DO EN1^SDPPDIS1
+23 IF SDLN1=SDLN
DO SET^SDPPDIS1("")
DO SET^SDPPDIS1(" No dispositions found.")
End DoDot:1
+24 IF SDTYP=7!(SDTYP=6)!($DATA(SDTYP(7)))
Begin DoDot:1
+25 if 'SDPRINT
DO CNTRL^VALM10(SDLN,20,35,IOINHI,IOINORM)
+26 SET SDLN1=SDLN
+27 DO TDATA^SDPPTEM(DFN,.VALMCNT)
End DoDot:1
+28 if 'SDPRINT
DO HDR^SDPP
+29 QUIT
+30 ;
QUIT ;
+1 SET VALMBCK="R"
+2 KILL BEGDATE,ENDDATE,DIC,DGINC,DGINR,DGREL,SD,SDASH,SDATA,SDDT,SDFLG,SDFST,SDIFN,SDJ,SDL,SDLD,SDPR,SDSEC,X,SD1,SDACT,SDAP,SDBEN,SDBENE,SDCAR,SDCARE,SDLN1
+3 KILL SDALL,SDCI,SDCL,SDDIS,SDFLN,SDLEN,SDLN,SDM,SDM1,SDMT,SDOB,SDPDATA,SDPOV,SDPV,SDSC,SDSEC,SDSTAT,SDAP,SDWHEN,SDSTATUS,SDVER,SDYN,SDOPT,SDACT,SDMT1,^TMP("SDPPALL",$JOB)
+4 QUIT
