Routine: SDAMEP1

SDAMEP1 ;ALB/CAW - Expanded Display (Appt. Data) ; 16 May 2001  4:49 PM  ; Compiled August 22, 2008 12:24:32

 ;;5.3;Scheduling;**20,241,534,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF 07/06/2000 removed data not needed by IHS from display

 ;                        moved overbook data to first column

 ;IHS/OIT/LJF  12/30/2005 PATCH 1005 displayed OTHER INFO in multiple lines

APDATA ; Appointment Data

 D SET($$SETSTR^VALM1("*** Appointment Demographics ***","",24,32))

 D CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)

 D SET("")

 S X=""

 S X=$$SETSTR^VALM1("           Name:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($P($G(^DPT(DFN,0)),U),X,SDFSTCOL,24)

 S X=$$SETSTR^VALM1("         Clinic:",X,40,SDWIDTH)

 S X=$$SETSTR^VALM1($P($G(^SC(SDCL,0)),U),X,SDSECCOL,24)

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("             ID:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1(VA("PID"),X,SDFSTCOL,24)

 S X=$$SETSTR^VALM1("      Date/Time:",X,40,SDWIDTH)

 S X=$$SETSTR^VALM1($$FTIME^VALM1(SDT),X,SDSECCOL,24)

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("         Status:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($P($$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0)),SDDA),";",3),X,SDFSTCOL,50)

 D SET(X)

 S SDPV=$P($G(^DPT(DFN,"S",SDT,0)),U,7),SDPOV=$S(SDPV=1:"C&P",SDPV=2:"10-10",SDPV=3:"SCHEDULED",SDPV=4:"UNSCHEDULED",1:"UNKNOWN")

 S X="",X=$$SETSTR^VALM1("Purpose of Vst.:",X,1,16)

 S X=$$SETSTR^VALM1(SDPOV,X,SDFSTCOL,24)

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1(" Length of Appt:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,1)),X,SDFSTCOL,4)

 ;S X=$$SETSTR^VALM1("      Appt Type:",X,40,SDWIDTH)     ;IHS/ANMC/LJF 7/06/2000

 ;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,9.5),X,SDSECCOL,24)    ;IHS/ANMC/LJF 7/06/2000

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("            Lab:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,5),"@",2),X,SDFSTCOL,5)

 ;S X=$$SETSTR^VALM1("   Elig of Appt:",X,40,SDWIDTH)         ;IHS/ANMC/LJF 7/06/2000

 ;S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,30)),X,SDSECCOL,24)  ;IHS/ANMC/LJF 7/06/2000

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("          X-ray:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,6),"@",2),X,SDFSTCOL,5)

 S X=$$SETSTR^VALM1("       Overbook:",X,40,SDWIDTH)

 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,9)),X,SDSECCOL,24)

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("            EKG:",X,1,SDWIDTH)

 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,7),"@",2),X,SDFSTCOL,5)

 ;S X=$$SETSTR^VALM1("Collateral Appt:",X,40,SDWIDTH)

 ;S X=$$SETSTR^VALM1($G(SDPT(2.98,SDT,13)),X,SDSECCOL,17)

 D SET(X)

 S X=""

 S X=$$SETSTR^VALM1("     Other Info:",X,1,SDWIDTH)

 ;IHS/OIT/LJF 12/30/2005 PATCH 1005 wrap to multiple lines if longer than 60 characters

 ;S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,3)),X,SDFSTCOL,60)

 ;D SET(X)

 NEW BSDR,I,BSDSAV S BSDSAV=X D WRAP^BDGF($G(SDSC(44.003,SDDA,3)),60,.BSDR)

 S X=BSDSAV,X=$$SETSTR^VALM1(BSDR(1),X,SDFSTCOL,60) D SET(X)   ;first line as before

 F I=2:1 Q:'$D(BSDR(I))  S X=$$REPEAT^XLFSTR(" ",SDWIDTH),X=$$SETSTR^VALM1(BSDR(I),X,SDFSTCOL,60) D SET(X)

 ;PATCH 1005 end of changes

 D SET(""),SET("") Q  ;IHS/ANMC/LJF 7/06/2000 enrollment data not needed

 S X=""

 N SDINFL S SDINFL=$L($G(SDSC(44.003,SDDA,3))) ; lenght of INFO STRING

 I SDINFL<64 D

 .S X=$$SETSTR^VALM1("          Other:",X,1,SDWIDTH)

 .S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,3)),X,SDFSTCOL,63)

 I SDINFL>63&(SDINFL<143) D

 .S X=$$SETSTR^VALM1("          Other:",X,1,SDWIDTH)

 .S X=$$SETSTR^VALM1($E($G(SDSC(44.003,SDDA,3)),1,64),X,17,80)

 .D SET(X)

 .S X=$$SETSTR^VALM1("",X,1,0)

 .S X=$$SETSTR^VALM1($E($G(SDSC(44.003,SDDA,3)),65,150),X,1,80)

 I SDINFL>142 D

 .S X=$$SETSTR^VALM1("   Other:",X,1,10)

 .S X=$$SETSTR^VALM1($E($G(SDSC(44.003,SDDA,3)),1,70),X,11,80)

 .D SET(X)

 .S X=$$SETSTR^VALM1("",X,1,0)

 .S X=$$SETSTR^VALM1($E($G(SDSC(44.003,SDDA,3)),71,150),X,1,80)

 D SET(X)

 S (X,SDEIC)="" F SDI=0:0 S SDI=$O(^DPT(DFN,"DE",SDI)) Q:'SDI  I $P(^(SDI,0),U)=SDCL F SDX=0:0 S SDX=$O(^DPT(DFN,"DE",SDI,1,SDX)) Q:'SDX  S SDEN=$G(^DPT(DFN,"DE",SDI,1,SDX,0))

 D ENROLL

 D SET($S($D(SDFLG):X,1:" "))

 S X="",X=$$SETSTR^VALM1($S('$D(SDEN):"",$P(SDEN,U)="":"",$P(SDEN,U,3)="":"Enrollment Date/Time:",1:""),X,4,21)

 I $D(SDEN),+SDEN,$P(SDEN,U,3)="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDEN,U)),X,26,18)

 D SET(X)

ENROLL ;

 S SDFLG=1

 S X="",X=$$SETSTR^VALM1("Enrolled in this clinic:",X,1,25)

 S X=$$SETSTR^VALM1($S('$D(SDEN):"NO",$P(SDEN,U)="":"NO",$P(SDEN,U,3)'="":"NO",1:"YES"),X,26,3)

 S X=$$SETSTR^VALM1($S('$D(SDEN):"",$P(SDEN,U)="":"",$P(SDEN,U,3)="":" OPT or AC:",$P(SDEN,U,3)'="":"Disch fm Clinic:",1:""),X,44,17)

 I $D(SDEN),+SDEN,$P(SDEN,U,3)="" S X=$$SETSTR^VALM1($S($P(SDEN,U,2)="A":"AC",1:"OPT"),X,SDSECCOL,3)

 I $D(SDEN),+SDEN,$P(SDEN,U,3)'="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDEN,U,3)),X,62,17)

SET(X) ; Set in ^TMP global for display

 S SDLN=SDLN+1,^TMP("SDAMEP",$J,SDLN,0)=X

INIT ; -- set up vars

 N DR,DIQ,DIC,DA

 D PID^VADPT6

 S SDFSTCOL=18,SDWIDTH=16,SDSECCOL=57

 I SDDA="" S SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)

 S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)

 S DIQ="SDPT(",DIC="^DPT(DFN,""S"",",DA=SDT,DR=".01;3;5;6;7;12;13;14;15;16;9.5;17;19;20;25;26;27;28" D EN^DIQ1

 S DIQ="SDSC(",DIC="^SC(SDCL,""S"",SDT,1,",DA=SDDA,DR="1;3;7;8;9;30;309;302;303;304;306" D EN^DIQ1

 I $G(SDOE) S DIQ="SDOE(",DIC="^SCE(",DA=+SDOE,DR=".07" D EN^DIQ1

 I $D(SDSC(44.003,SDDA,30)),SDSC(44.003,SDDA,30)="" S SDSC(44.003,SDDA,30)=$P($G(^DIC(8,+$G(^DPT(DFN,.36)),0)),U)

 I $D(SDSC(44.003,SDDA,9)),SDSC(44.003,SDDA,9)="" S SDSC(44.003,SDDA,9)="NO"

 I $D(SDPT(2.98,SDT,13)),SDPT(2.98,SDT,13)="" S SDPT(2.98,SDT,13)="NO"

 S DIQ(0)="I",DIQ="SDPTI(",DIC="^DPT(DFN,""S"",",DA=SDT,DR="3;20;25;26;27;28" D EN^DIQ1

SDAMEP1   ;ALB/CAW - Expanded Display (Appt. Data) ; 16 May 2001  4:49 PM  ; Compiled August 22, 2008 12:24:32

 +1       ;;5.3;Scheduling;**20,241,534,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF 07/06/2000 removed data not needed by IHS from display

 +3       ;                        moved overbook data to first column

 +4       ;IHS/OIT/LJF  12/30/2005 PATCH 1005 displayed OTHER INFO in multiple lines

 +5       ;

APDATA    ; Appointment Data

 +1       ;

 +2        DO SET($$SETSTR^VALM1("*** Appointment Demographics ***","",24,32))

 +3        DO CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)

 +4        DO SET("")

 +5       ;

 +6        SET X=""

 +7        SET X=$$SETSTR^VALM1("           Name:",X,1,SDWIDTH)

 +8        SET X=$$SETSTR^VALM1($PIECE($GET(^DPT(DFN,0)),U),X,SDFSTCOL,24)

 +9        SET X=$$SETSTR^VALM1("         Clinic:",X,40,SDWIDTH)

 +10       SET X=$$SETSTR^VALM1($PIECE($GET(^SC(SDCL,0)),U),X,SDSECCOL,24)

 +11       DO SET(X)

 +12      ;

 +13       SET X=""

 +14       SET X=$$SETSTR^VALM1("             ID:",X,1,SDWIDTH)

 +15       SET X=$$SETSTR^VALM1(VA("PID"),X,SDFSTCOL,24)

 +16       SET X=$$SETSTR^VALM1("      Date/Time:",X,40,SDWIDTH)

 +17       SET X=$$SETSTR^VALM1($$FTIME^VALM1(SDT),X,SDSECCOL,24)

 +18       DO SET(X)

 +19      ;

 +20       SET X=""

 +21       SET X=$$SETSTR^VALM1("         Status:",X,1,SDWIDTH)

 +22       SET X=$$SETSTR^VALM1($PIECE($$STATUS^SDAM1(DFN,SDT,SDCL,$GET(^DPT(DFN,"S",SDT,0)),SDDA),";",3),X,SDFSTCOL,50)

 +23       DO SET(X)

 +24      ;

 +25       SET SDPV=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,7)

           SET SDPOV=$SELECT(SDPV=1:"C&P",SDPV=2:"10-10",SDPV=3:"SCHEDULED",SDPV=4:"UNSCHEDULED",1:"UNKNOWN")

 +26       SET X=""

           SET X=$$SETSTR^VALM1("Purpose of Vst.:",X,1,16)

 +27       SET X=$$SETSTR^VALM1(SDPOV,X,SDFSTCOL,24)

 +28       DO SET(X)

 +29      ;

 +30       SET X=""

 +31       SET X=$$SETSTR^VALM1(" Length of Appt:",X,1,SDWIDTH)

 +32       SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,1)),X,SDFSTCOL,4)

 +33      ;S X=$$SETSTR^VALM1("      Appt Type:",X,40,SDWIDTH)     ;IHS/ANMC/LJF 7/06/2000

 +34      ;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,9.5),X,SDSECCOL,24)    ;IHS/ANMC/LJF 7/06/2000

 +35       DO SET(X)

 +36      ;

 +37       SET X=""

 +38       SET X=$$SETSTR^VALM1("            Lab:",X,1,SDWIDTH)

 +39       SET X=$$SETSTR^VALM1($PIECE(SDPT(2.98,SDT,5),"@",2),X,SDFSTCOL,5)

 +40      ;S X=$$SETSTR^VALM1("   Elig of Appt:",X,40,SDWIDTH)         ;IHS/ANMC/LJF 7/06/2000

 +41      ;S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,30)),X,SDSECCOL,24)  ;IHS/ANMC/LJF 7/06/2000

 +42       DO SET(X)

 +43      ;

 +44       SET X=""

 +45       SET X=$$SETSTR^VALM1("          X-ray:",X,1,SDWIDTH)

 +46       SET X=$$SETSTR^VALM1($PIECE(SDPT(2.98,SDT,6),"@",2),X,SDFSTCOL,5)

 +47       SET X=$$SETSTR^VALM1("       Overbook:",X,40,SDWIDTH)

 +48       SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,9)),X,SDSECCOL,24)

 +49       DO SET(X)

 +50      ;

 +51       SET X=""

 +52       SET X=$$SETSTR^VALM1("            EKG:",X,1,SDWIDTH)

 +53       SET X=$$SETSTR^VALM1($PIECE(SDPT(2.98,SDT,7),"@",2),X,SDFSTCOL,5)

 +54      ;S X=$$SETSTR^VALM1("Collateral Appt:",X,40,SDWIDTH)

 +55      ;S X=$$SETSTR^VALM1($G(SDPT(2.98,SDT,13)),X,SDSECCOL,17)

 +56       DO SET(X)

 +57      ;

 +58       SET X=""

 +59       SET X=$$SETSTR^VALM1("     Other Info:",X,1,SDWIDTH)

 +60      ;

 +61      ;IHS/OIT/LJF 12/30/2005 PATCH 1005 wrap to multiple lines if longer than 60 characters

 +62      ;S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,3)),X,SDFSTCOL,60)

 +63      ;D SET(X)

 +64       NEW BSDR,I,BSDSAV

           SET BSDSAV=X

           DO WRAP^BDGF($GET(SDSC(44.003,SDDA,3)),60,.BSDR)

 +65      ;first line as before

           SET X=BSDSAV

           SET X=$$SETSTR^VALM1(BSDR(1),X,SDFSTCOL,60)

           DO SET(X)

 +66       FOR I=2:1

               IF '$DATA(BSDR(I))

                   QUIT

               SET X=$$REPEAT^XLFSTR(" ",SDWIDTH)

               SET X=$$SETSTR^VALM1(BSDR(I),X,SDFSTCOL,60)

               DO SET(X)

 +67      ;PATCH 1005 end of changes

 +68      ;

 +69      ;IHS/ANMC/LJF 7/06/2000 enrollment data not needed

           DO SET("")

           DO SET("")

           QUIT

 +70      ;

 +71       SET X=""

 +72      ; lenght of INFO STRING

           NEW SDINFL

           SET SDINFL=$LENGTH($GET(SDSC(44.003,SDDA,3)))

 +73       IF SDINFL<64

               Begin DoDot:1

 +74               SET X=$$SETSTR^VALM1("          Other:",X,1,SDWIDTH)

 +75               SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,3)),X,SDFSTCOL,63)

               End DoDot:1

 +76       IF SDINFL>63&(SDINFL<143)

               Begin DoDot:1

 +77               SET X=$$SETSTR^VALM1("          Other:",X,1,SDWIDTH)

 +78               SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,64),X,17,80)

 +79               DO SET(X)

 +80               SET X=$$SETSTR^VALM1("",X,1,0)

 +81               SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),65,150),X,1,80)

               End DoDot:1

 +82       IF SDINFL>142

               Begin DoDot:1

 +83               SET X=$$SETSTR^VALM1("   Other:",X,1,10)

 +84               SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,70),X,11,80)

 +85               DO SET(X)

 +86               SET X=$$SETSTR^VALM1("",X,1,0)

 +87               SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),71,150),X,1,80)

               End DoDot:1

 +88       DO SET(X)

 +89      ;

 +90       SET (X,SDEIC)=""

           FOR SDI=0:0

               SET SDI=$ORDER(^DPT(DFN,"DE",SDI))

               IF 'SDI

                   QUIT

               IF $PIECE(^(SDI,0),U)=SDCL

                   FOR SDX=0:0

                       SET SDX=$ORDER(^DPT(DFN,"DE",SDI,1,SDX))

                       IF 'SDX

                           QUIT

                       SET SDEN=$GET(^DPT(DFN,"DE",SDI,1,SDX,0))

 +91       DO ENROLL

 +92       DO SET($SELECT($DATA(SDFLG):X,1:" "))

 +93       SET X=""

           SET X=$$SETSTR^VALM1($SELECT('$DATA(SDEN):"",$PIECE(SDEN,U)="":"",$PIECE(SDEN,U,3)="":"Enrollment Date/Time:",1:""),X,4,21)

 +94       IF $DATA(SDEN)

               IF +SDEN

                   IF $PIECE(SDEN,U,3)=""

                       SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDEN,U)),X,26,18)

 +95       DO SET(X)

 +96       QUIT

 +97      ;

ENROLL    ;

 +1        SET SDFLG=1

 +2        SET X=""

           SET X=$$SETSTR^VALM1("Enrolled in this clinic:",X,1,25)

 +3        SET X=$$SETSTR^VALM1($SELECT('$DATA(SDEN):"NO",$PIECE(SDEN,U)="":"NO",$PIECE(SDEN,U,3)'="":"NO",1:"YES"),X,26,3)

 +4        SET X=$$SETSTR^VALM1($SELECT('$DATA(SDEN):"",$PIECE(SDEN,U)="":"",$PIECE(SDEN,U,3)="":" OPT or AC:",$PIECE(SDEN,U,3)'="":"Disch fm Clinic:",1:""),X,44,17)

 +5        IF $DATA(SDEN)

               IF +SDEN

                   IF $PIECE(SDEN,U,3)=""

                       SET X=$$SETSTR^VALM1($SELECT($PIECE(SDEN,U,2)="A":"AC",1:"OPT"),X,SDSECCOL,3)

 +6        IF $DATA(SDEN)

               IF +SDEN

                   IF $PIECE(SDEN,U,3)'=""

                       SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDEN,U,3)),X,62,17)

 +7        QUIT

SET(X)    ; Set in ^TMP global for display

 +1       ;

 +2        SET SDLN=SDLN+1

           SET ^TMP("SDAMEP",$JOB,SDLN,0)=X

 +3        QUIT

 +4       ;

INIT      ; -- set up vars

 +1        NEW DR,DIQ,DIC,DA

 +2        DO PID^VADPT6

 +3        SET SDFSTCOL=18

           SET SDWIDTH=16

           SET SDSECCOL=57

 +4        IF SDDA=""

               SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)

 +5        SET SDOE=+$PIECE($GET(^DPT(DFN,"S",SDT,0)),"^",20)

 +6        SET DIQ="SDPT("

           SET DIC="^DPT(DFN,""S"","

           SET DA=SDT

           SET DR=".01;3;5;6;7;12;13;14;15;16;9.5;17;19;20;25;26;27;28"

           DO EN^DIQ1

 +7        SET DIQ="SDSC("

           SET DIC="^SC(SDCL,""S"",SDT,1,"

           SET DA=SDDA

           SET DR="1;3;7;8;9;30;309;302;303;304;306"

           DO EN^DIQ1

 +8        IF $GET(SDOE)

               SET DIQ="SDOE("

               SET DIC="^SCE("

               SET DA=+SDOE

               SET DR=".07"

               DO EN^DIQ1

 +9        IF $DATA(SDSC(44.003,SDDA,30))

               IF SDSC(44.003,SDDA,30)=""

                   SET SDSC(44.003,SDDA,30)=$PIECE($GET(^DIC(8,+$GET(^DPT(DFN,.36)),0)),U)

 +10       IF $DATA(SDSC(44.003,SDDA,9))

               IF SDSC(44.003,SDDA,9)=""

                   SET SDSC(44.003,SDDA,9)="NO"

 +11       IF $DATA(SDPT(2.98,SDT,13))

               IF SDPT(2.98,SDT,13)=""

                   SET SDPT(2.98,SDT,13)="NO"

 +12       SET DIQ(0)="I"

           SET DIQ="SDPTI("

           SET DIC="^DPT(DFN,""S"","

           SET DA=SDT

           SET DR="3;20;25;26;27;28"

           DO EN^DIQ1

 +13       QUIT

SDAMEP1.m