- 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 Apr 23, 2025@19:14:17 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