- SDAMEP1 ;ALB/CAW,MGD - Expanded Display (Appt. Data) ; NOV 13, 2024
- ;;5.3;Scheduling;**20,241,534,895**;Aug 13, 1993;Build 11
- ;
- ; Reference to ^$$ELIG^DGCOMPACTELIG in ICR #7462
- ;
- 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)
- S X=$$SETSTR^VALM1(SDPT(2.98,SDT,9.5),X,SDSECCOL,24)
- 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)
- S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,30)),X,SDSECCOL,24)
- D SET(X)
- ;
- N SDCOMPACT
- S SDCOMPACT=$$ELIG^DGCOMPACTELIG(DFN,"SDAMEP1")
- 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(" COMPACT Elig:",X,40,SDWIDTH)
- S X=$$SETSTR^VALM1(SDCOMPACT,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(" 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("Collateral Appt:",X,40,SDWIDTH)
- S X=$$SETSTR^VALM1($G(SDPT(2.98,SDT,13)),X,SDSECCOL,17)
- D SET(X)
- ;
- S X=""
- N SDINFL S SDINFL=$L($G(SDSC(44.003,SDDA,3))) ; length 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)
- Q
- ;
- 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)
- Q
- SET(X) ; Set in ^TMP global for display
- ;
- S SDLN=SDLN+1,^TMP("SDAMEP",$J,SDLN,0)=X
- Q
- ;
- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMEP1 5029 printed Feb 19, 2025@00:14:01 Page 2
- SDAMEP1 ;ALB/CAW,MGD - Expanded Display (Appt. Data) ; NOV 13, 2024
- +1 ;;5.3;Scheduling;**20,241,534,895**;Aug 13, 1993;Build 11
- +2 ;
- +3 ; Reference to ^$$ELIG^DGCOMPACTELIG in ICR #7462
- +4 ;
- 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 SET X=$$SETSTR^VALM1(" Appt Type:",X,40,SDWIDTH)
- +34 SET X=$$SETSTR^VALM1(SDPT(2.98,SDT,9.5),X,SDSECCOL,24)
- +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 SET X=$$SETSTR^VALM1(" Elig of Appt:",X,40,SDWIDTH)
- +41 SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,30)),X,SDSECCOL,24)
- +42 DO SET(X)
- +43 ;
- +44 NEW SDCOMPACT
- +45 SET SDCOMPACT=$$ELIG^DGCOMPACTELIG(DFN,"SDAMEP1")
- +46 SET X=""
- +47 SET X=$$SETSTR^VALM1(" X-ray:",X,1,SDWIDTH)
- +48 SET X=$$SETSTR^VALM1($PIECE(SDPT(2.98,SDT,6),"@",2),X,SDFSTCOL,5)
- +49 SET X=$$SETSTR^VALM1(" COMPACT Elig:",X,40,SDWIDTH)
- +50 SET X=$$SETSTR^VALM1(SDCOMPACT,X,SDSECCOL,24)
- +51 DO SET(X)
- +52 ;
- +53 SET X=""
- +54 SET X=$$SETSTR^VALM1(" EKG:",X,1,SDWIDTH)
- +55 SET X=$$SETSTR^VALM1($PIECE(SDPT(2.98,SDT,7),"@",2),X,SDFSTCOL,5)
- +56 SET X=$$SETSTR^VALM1(" Overbook:",X,40,SDWIDTH)
- +57 SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,9)),X,SDSECCOL,24)
- +58 DO SET(X)
- +59 ;
- +60 SET X=""
- +61 SET X=$$SETSTR^VALM1("Collateral Appt:",X,40,SDWIDTH)
- +62 SET X=$$SETSTR^VALM1($GET(SDPT(2.98,SDT,13)),X,SDSECCOL,17)
- +63 DO SET(X)
- +64 ;
- +65 SET X=""
- +66 ; length of INFO STRING
- NEW SDINFL
- SET SDINFL=$LENGTH($GET(SDSC(44.003,SDDA,3)))
- +67 IF SDINFL<64
- Begin DoDot:1
- +68 SET X=$$SETSTR^VALM1(" Other:",X,1,SDWIDTH)
- +69 SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,3)),X,SDFSTCOL,63)
- End DoDot:1
- +70 IF SDINFL>63&(SDINFL<143)
- Begin DoDot:1
- +71 SET X=$$SETSTR^VALM1(" Other:",X,1,SDWIDTH)
- +72 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,64),X,17,80)
- +73 DO SET(X)
- +74 SET X=$$SETSTR^VALM1("",X,1,0)
- +75 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),65,150),X,1,80)
- End DoDot:1
- +76 IF SDINFL>142
- Begin DoDot:1
- +77 SET X=$$SETSTR^VALM1(" Other:",X,1,10)
- +78 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,70),X,11,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)),71,150),X,1,80)
- End DoDot:1
- +82 DO SET(X)
- +83 ;
- +84 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))
- +85 DO ENROLL
- +86 DO SET($SELECT($DATA(SDFLG):X,1:" "))
- +87 SET X=""
- SET X=$$SETSTR^VALM1($SELECT('$DATA(SDEN):"",$PIECE(SDEN,U)="":"",$PIECE(SDEN,U,3)="":"Enrollment Date/Time:",1:""),X,4,21)
- +88 IF $DATA(SDEN)
- IF +SDEN
- IF $PIECE(SDEN,U,3)=""
- SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDEN,U)),X,26,18)
- +89 DO SET(X)
- +90 QUIT
- +91 ;
- 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