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**;Aug 13, 1993;Build 8
;
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)
;
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=""
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)
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 4821 printed Apr 09, 2024@22:03:28 Page 2
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**;Aug 13, 1993;Build 8
+2 ;
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 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 SET X=$$SETSTR^VALM1("Collateral Appt:",X,40,SDWIDTH)
+55 SET X=$$SETSTR^VALM1($GET(SDPT(2.98,SDT,13)),X,SDSECCOL,17)
+56 DO SET(X)
+57 ;
+58 SET X=""
+59 ; lenght of INFO STRING
NEW SDINFL
SET SDINFL=$LENGTH($GET(SDSC(44.003,SDDA,3)))
+60 IF SDINFL<64
Begin DoDot:1
+61 SET X=$$SETSTR^VALM1(" Other:",X,1,SDWIDTH)
+62 SET X=$$SETSTR^VALM1($GET(SDSC(44.003,SDDA,3)),X,SDFSTCOL,63)
End DoDot:1
+63 IF SDINFL>63&(SDINFL<143)
Begin DoDot:1
+64 SET X=$$SETSTR^VALM1(" Other:",X,1,SDWIDTH)
+65 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,64),X,17,80)
+66 DO SET(X)
+67 SET X=$$SETSTR^VALM1("",X,1,0)
+68 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),65,150),X,1,80)
End DoDot:1
+69 IF SDINFL>142
Begin DoDot:1
+70 SET X=$$SETSTR^VALM1(" Other:",X,1,10)
+71 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),1,70),X,11,80)
+72 DO SET(X)
+73 SET X=$$SETSTR^VALM1("",X,1,0)
+74 SET X=$$SETSTR^VALM1($EXTRACT($GET(SDSC(44.003,SDDA,3)),71,150),X,1,80)
End DoDot:1
+75 DO SET(X)
+76 ;
+77 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))
+78 DO ENROLL
+79 DO SET($SELECT($DATA(SDFLG):X,1:" "))
+80 SET X=""
SET X=$$SETSTR^VALM1($SELECT('$DATA(SDEN):"",$PIECE(SDEN,U)="":"",$PIECE(SDEN,U,3)="":"Enrollment Date/Time:",1:""),X,4,21)
+81 IF $DATA(SDEN)
IF +SDEN
IF $PIECE(SDEN,U,3)=""
SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDEN,U)),X,26,18)
+82 DO SET(X)
+83 QUIT
+84 ;
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
