SDPPALL.m

SDPPALL ;ALB/CAW - Patient Profile - All ; 29 Jun 99  04:11PM

 ;;5.3;Scheduling;**6,41,177,1015**;AUG 13, 1993;Build 21

 ;

 ;

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

SDPPALL   ;ALB/CAW - Patient Profile - All ; 29 Jun 99  04:11PM

 +1       ;;5.3;Scheduling;**6,41,177,1015**;AUG 13, 1993;Build 21

 +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