SDAMEP2 ;ALB/CAW,MGD - Extended Display (Patient Data) ; NOV 13, 2024
;;5.3;Scheduling;**258,325,441,777,895**;Aug 13, 1993;Build 11
;
; Reference to ^$$ELIG^DGCOMPACTELIG in ICR #7462
;
PDATA ; Patient Data
F SD=0,.11,.13,.32,.322,.321,.36,.52 S SD(SD)=$G(^DPT(DFN,SD))
S SD("CV")=$$CVEDT^DGCV(DFN,SDT)
S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10
S SDFSTCOL=16,SDSECCOL=60
S X="" D SET^SDAMEP1($$SETSTR^VALM1("*** Patient Information ***",X,25,30))
D CNTRL^VALM10(SDLN,25,30,IOINHI,IOINORM)
PTDOB ; Date of Birth and SSN Info
;
S X="",X=$$SETSTR^VALM1("Date of Birth:",X,1,14)
S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SD(0),U,3)),X,SDFSTCOL,18)
S X=$$SETSTR^VALM1(" ID:",X,55,4)
S X=$$SETSTR^VALM1(VA("PID"),X,SDSECCOL,20)
D SET^SDAMEP1(X)
PTSEX ; Sex and Marital Status Info
;
S X="",X=$$SETSTR^VALM1("Sex:",X,11,4)
S X=$$SETSTR^VALM1($S($P(SD(0),U,2)="F":"FEMALE",$P(SD(0),U,2)="M":"MALE",1:"UNKNOWN"),X,SDFSTCOL,18)
S X=$$SETSTR^VALM1("Marital Status:",X,44,15)
S X=$$SETSTR^VALM1($P($G(^DIC(11,+$P(SD(0),U,5),0)),U),X,SDSECCOL,20)
D SET^SDAMEP1(X)
PTREL ; Religious Pref. Info
;
S X="",X=$$SETSTR^VALM1("Religious Pref.:",X,43,16)
S X=$$SETSTR^VALM1($P($G(^DIC(13,+$P(SD(0),U,8),0)),U),X,SDSECCOL,20)
D SET^SDAMEP1(X)
PTMT ; Means Test Info
;
S SDMT=$$LST^DGMTU(DFN),X="" G:$P(SDMT,U,4)="N" PTCO I +SDMT D G PTMTQ
.S X=$$SETSTR^VALM1("Means Test:",X,4,11)
.S X=$$SETSTR^VALM1($P($$FMT^SDUTL2(DFN),U),X,SDFSTCOL,20)
.S X=$$SETSTR^VALM1("Last Means Test:",X,43,16)
.S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDMT,U,2)),X,SDSECCOL,20)
PTCO S SDMT=$$LST^DGMTU(DFN,"",2),X="" I +SDMT D
.S X=$$SETSTR^VALM1("Co-Pay Test:",X,3,12)
.S X=$$SETSTR^VALM1($P($$FCO^SDUTL2(DFN),U,2),X,SDFSTCOL,10)
.S X=$$SETSTR^VALM1("Last Co-Pay Test:",X,42,17)
.S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDMT,U,2)),X,SDSECCOL,20)
PTMTQ D SET^SDAMEP1(X)
PTELG ; Primary Eligibility and Period of Service Info
;
S X="",X=$$SETSTR^VALM1("Primary Elig.:",X,1,14)
S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SD(.36),U),0)),U,6),X,SDFSTCOL,21)
S X=$$SETSTR^VALM1("POS:",X,55,4)
S X=$$SETSTR^VALM1($P($G(^DIC(21,+$P(SD(.32),U,3),0)),U),X,SDSECCOL,20)
D SET^SDAMEP1(X)
;
N SDCOMPACT
S SDCOMPACT=$$ELIG^DGCOMPACTELIG(DFN,"SDAMEP2")
S X="",X=$$SETSTR^VALM1("COMPACT Elig.:",X,1,14)
S X=$$SETSTR^VALM1(SDCOMPACT,X,SDFSTCOL,21)
D SET^SDAMEP1(X)
;
PTADD ; Patient Address
;
S X="",X=($$SETSTR^VALM1("Address:",X,7,8))
S X=$$SETSTR^VALM1("Phone:",X,53,6)
S X=$$SETSTR^VALM1($P(SD(.13),U),X,SDSECCOL,20)
D SET^SDAMEP1(X)
S X="",X=($$SETSTR^VALM1($P(SD(.11),U),X,10,30))
S X=$$SETSTR^VALM1("Cell Phone:",X,48,11)
S X=$$SETSTR^VALM1($S(($P(SD(.13),U,4)'=""):$P(SD(.13),U,4),1:"UNANSWERED"),X,SDSECCOL,20)
D SET^SDAMEP1(X)
S X="",SDPAGFLG=0
I $P(SD(.11),U,2)'="" D
.S X="",X=($$SETSTR^VALM1($P(SD(.11),U,2),X,10,30))
.S X=$$SETSTR^VALM1("Pager #:",X,51,8)
.S X=$$SETSTR^VALM1($S(($P(SD(.13),U,5)'=""):$P(SD(.13),U,5),1:"UNANSWERED"),X,SDSECCOL,20),SDPAGFLG=1
D:X'="" SET^SDAMEP1(X)
; retrieve country info -- PERM country is piece 10 of .11
N FILE,CNTRY,FORIEN,FOREIGN
S FILE=779.004,FORIEN=$P(SD(.11),U,10),CNTRY=$$GET1^DIQ(FILE,FORIEN_",",2),CNTRY=$$UPPER^VALM1(CNTRY),FOREIGN=$$FORIEN^DGADDUTL(FORIEN)
I 'FOREIGN D
. N SDZIP S SDZIP=$P(SD(.11),U,12) S:$E(SDZIP,6,10)'="" SDZIP=$E(SDZIP,1,5)_"-"_$E(SDZIP,6,10)
. S X="",X=($$SETSTR^VALM1($P(SD(.11),U,4)_", "_$P($G(^DIC(5,+$P(SD(.11),U,5),0)),U)_" "_SDZIP,X,10,45))
E D
. S X="",X=($$SETSTR^VALM1($P(SD(.11),U,9)_" "_$P(SD(.11),U,4)_" "_$P(SD(.11),U,8),X,10,45))
I 'SDPAGFLG D
.S X=$$SETSTR^VALM1("Pager #:",X,51,8)
.S X=$$SETSTR^VALM1($S(($P(SD(.13),U,5)'=""):$P(SD(.13),U,5),1:"UNANSWERED"),X,SDSECCOL,20)
D SET^SDAMEP1(X) K SDPAGFLG
S X="",X=$$SETSTR^VALM1(CNTRY,X,10,45)
D SET^SDAMEP1(X)
S X="",X=$$SETSTR^VALM1("EMAIL ADDRESS:",X,1,14)
S X=$$SETSTR^VALM1($S(($P(SD(.13),U,3)'=""):$P(SD(.13),U,3),1:"UNANSWERED"),X,SDFSTCOL,45)
D SET^SDAMEP1(X)
PTEXP ; Radiation and Status
;
S X="",X=$$SETSTR^VALM1("Radiation Exposure:",X,1,19)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.321),U,3)),X,21,7)
S X=$$SETSTR^VALM1("Status:",X,52,7)
S A=$S("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2)),SDST=$S('A:"IN",1:"")_"ACTIVE ",SDSTA=$S("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",1:"INPATIENT")
I '$D(^DGPM("C",DFN)) S SDST="NO INPT./LOD. ACT.",SDSTA=""
S X=$$SETSTR^VALM1(SDST_SDSTA,X,SDSECCOL,20)
D SET^SDAMEP1(X)
PTPOW ; Prisoner of War Info and Last Admission Date
;
S X="",X=$$SETSTR^VALM1("Prisoner of War:",X,4,16)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.52),U,5)),X,21,7)
S X=$$SETSTR^VALM1("Last Admit/Lodger Date:",X,36,23)
I +DGPMVI(13,1) S X=$$SETSTR^VALM1($$FTIME^VALM1(+DGPMVI(13,1)),X,SDSECCOL,18)
D SET^SDAMEP1(X)
PTAO ; Agent Orange Exposure and Last Discharge Date
S X="",X=$$SETSTR^VALM1("AO Exp/Loc:",X,9,11)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.321),U,2))_$S($P(SD(.321),U,13)="V":"/VIET",$P(SD(.321),U,13)="K":"/DMZ",$P(SD(.321),U,13)="O":"/OTH",$P(SD(.321),U,13)="B":"/BWN",1:""),X,21,14) ;SD*5.3*777 - Add BWN
S X=$$SETSTR^VALM1("Last Disch./Lodger Date:",X,35,24)
S SDDISCH=+$G(^DGPM(+DGPMVI(17),0))
I +SDDISCH S X=$$SETSTR^VALM1($$FTIME^VALM1(SDDISCH),X,SDSECCOL,18)
D SET^SDAMEP1(X)
CV ;Combat vet
S X="",X=$$SETSTR^VALM1("Combat Veteran:",X,5,15)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($S($P(SD("CV"),U,1)>0:"Y",1:"N")),X,21,7)
S X=$$SETSTR^VALM1("Combat Veteran End Date:",X,35,24)
I $P(SD("CV"),U,1)>0 D
.S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SD("CV"),U,2)),X,SDSECCOL,18)
E S X=$$SETSTR^VALM1("N/A",X,SDSECCOL,3)
D SET^SDAMEP1(X)
SHAD ;PROJ 112/SHAD
S X="",X=$$SETSTR^VALM1("PROJ 112/SHAD:",X,6,14)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($S($P(SD(.321),U,15)>0:"Y",1:"N")),X,21,7)
SWASIA ;SW Asia
S X=$$SETSTR^VALM1("SW Asia Conditions:",X,40,19)
S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.322),U,13)),X,SDSECCOL,20)
D SET^SDAMEP1(X)
D SET^SDAMEP1("")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMEP2 6001 printed Sep 23, 2025@20:23:59 Page 2
SDAMEP2 ;ALB/CAW,MGD - Extended Display (Patient Data) ; NOV 13, 2024
+1 ;;5.3;Scheduling;**258,325,441,777,895**;Aug 13, 1993;Build 11
+2 ;
+3 ; Reference to ^$$ELIG^DGCOMPACTELIG in ICR #7462
+4 ;
PDATA ; Patient Data
+1 FOR SD=0,.11,.13,.32,.322,.321,.36,.52
SET SD(SD)=$GET(^DPT(DFN,SD))
+2 SET SD("CV")=$$CVEDT^DGCV(DFN,SDT)
+3 SET VAIP("D")="L"
SET VAIP("L")=""
DO INP^DGPMV10
+4 SET SDFSTCOL=16
SET SDSECCOL=60
+5 SET X=""
DO SET^SDAMEP1($$SETSTR^VALM1("*** Patient Information ***",X,25,30))
+6 DO CNTRL^VALM10(SDLN,25,30,IOINHI,IOINORM)
PTDOB ; Date of Birth and SSN Info
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Date of Birth:",X,1,14)
+3 SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SD(0),U,3)),X,SDFSTCOL,18)
+4 SET X=$$SETSTR^VALM1(" ID:",X,55,4)
+5 SET X=$$SETSTR^VALM1(VA("PID"),X,SDSECCOL,20)
+6 DO SET^SDAMEP1(X)
PTSEX ; Sex and Marital Status Info
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Sex:",X,11,4)
+3 SET X=$$SETSTR^VALM1($SELECT($PIECE(SD(0),U,2)="F":"FEMALE",$PIECE(SD(0),U,2)="M":"MALE",1:"UNKNOWN"),X,SDFSTCOL,18)
+4 SET X=$$SETSTR^VALM1("Marital Status:",X,44,15)
+5 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(11,+$PIECE(SD(0),U,5),0)),U),X,SDSECCOL,20)
+6 DO SET^SDAMEP1(X)
PTREL ; Religious Pref. Info
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Religious Pref.:",X,43,16)
+3 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(13,+$PIECE(SD(0),U,8),0)),U),X,SDSECCOL,20)
+4 DO SET^SDAMEP1(X)
PTMT ; Means Test Info
+1 ;
+2 SET SDMT=$$LST^DGMTU(DFN)
SET X=""
if $PIECE(SDMT,U,4)="N"
GOTO PTCO
IF +SDMT
Begin DoDot:1
+3 SET X=$$SETSTR^VALM1("Means Test:",X,4,11)
+4 SET X=$$SETSTR^VALM1($PIECE($$FMT^SDUTL2(DFN),U),X,SDFSTCOL,20)
+5 SET X=$$SETSTR^VALM1("Last Means Test:",X,43,16)
+6 SET X=$$SETSTR^VALM1($$FDATE^VALM1($PIECE(SDMT,U,2)),X,SDSECCOL,20)
End DoDot:1
GOTO PTMTQ
PTCO SET SDMT=$$LST^DGMTU(DFN,"",2)
SET X=""
IF +SDMT
Begin DoDot:1
+1 SET X=$$SETSTR^VALM1("Co-Pay Test:",X,3,12)
+2 SET X=$$SETSTR^VALM1($PIECE($$FCO^SDUTL2(DFN),U,2),X,SDFSTCOL,10)
+3 SET X=$$SETSTR^VALM1("Last Co-Pay Test:",X,42,17)
+4 SET X=$$SETSTR^VALM1($$FDATE^VALM1($PIECE(SDMT,U,2)),X,SDSECCOL,20)
End DoDot:1
PTMTQ DO SET^SDAMEP1(X)
PTELG ; Primary Eligibility and Period of Service Info
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Primary Elig.:",X,1,14)
+3 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(8,+$PIECE(SD(.36),U),0)),U,6),X,SDFSTCOL,21)
+4 SET X=$$SETSTR^VALM1("POS:",X,55,4)
+5 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(21,+$PIECE(SD(.32),U,3),0)),U),X,SDSECCOL,20)
+6 DO SET^SDAMEP1(X)
+7 ;
+8 NEW SDCOMPACT
+9 SET SDCOMPACT=$$ELIG^DGCOMPACTELIG(DFN,"SDAMEP2")
+10 SET X=""
SET X=$$SETSTR^VALM1("COMPACT Elig.:",X,1,14)
+11 SET X=$$SETSTR^VALM1(SDCOMPACT,X,SDFSTCOL,21)
+12 DO SET^SDAMEP1(X)
+13 ;
PTADD ; Patient Address
+1 ;
+2 SET X=""
SET X=($$SETSTR^VALM1("Address:",X,7,8))
+3 SET X=$$SETSTR^VALM1("Phone:",X,53,6)
+4 SET X=$$SETSTR^VALM1($PIECE(SD(.13),U),X,SDSECCOL,20)
+5 DO SET^SDAMEP1(X)
+6 SET X=""
SET X=($$SETSTR^VALM1($PIECE(SD(.11),U),X,10,30))
+7 SET X=$$SETSTR^VALM1("Cell Phone:",X,48,11)
+8 SET X=$$SETSTR^VALM1($SELECT(($PIECE(SD(.13),U,4)'=""):$PIECE(SD(.13),U,4),1:"UNANSWERED"),X,SDSECCOL,20)
+9 DO SET^SDAMEP1(X)
+10 SET X=""
SET SDPAGFLG=0
+11 IF $PIECE(SD(.11),U,2)'=""
Begin DoDot:1
+12 SET X=""
SET X=($$SETSTR^VALM1($PIECE(SD(.11),U,2),X,10,30))
+13 SET X=$$SETSTR^VALM1("Pager #:",X,51,8)
+14 SET X=$$SETSTR^VALM1($SELECT(($PIECE(SD(.13),U,5)'=""):$PIECE(SD(.13),U,5),1:"UNANSWERED"),X,SDSECCOL,20)
SET SDPAGFLG=1
End DoDot:1
+15 if X'=""
DO SET^SDAMEP1(X)
+16 ; retrieve country info -- PERM country is piece 10 of .11
+17 NEW FILE,CNTRY,FORIEN,FOREIGN
+18 SET FILE=779.004
SET FORIEN=$PIECE(SD(.11),U,10)
SET CNTRY=$$GET1^DIQ(FILE,FORIEN_",",2)
SET CNTRY=$$UPPER^VALM1(CNTRY)
SET FOREIGN=$$FORIEN^DGADDUTL(FORIEN)
+19 IF 'FOREIGN
Begin DoDot:1
+20 NEW SDZIP
SET SDZIP=$PIECE(SD(.11),U,12)
if $EXTRACT(SDZIP,6,10)'=""
SET SDZIP=$EXTRACT(SDZIP,1,5)_"-"_$EXTRACT(SDZIP,6,10)
+21 SET X=""
SET X=($$SETSTR^VALM1($PIECE(SD(.11),U,4)_", "_$PIECE($GET(^DIC(5,+$PIECE(SD(.11),U,5),0)),U)_" "_SDZIP,X,10,45))
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET X=""
SET X=($$SETSTR^VALM1($PIECE(SD(.11),U,9)_" "_$PIECE(SD(.11),U,4)_" "_$PIECE(SD(.11),U,8),X,10,45))
End DoDot:1
+24 IF 'SDPAGFLG
Begin DoDot:1
+25 SET X=$$SETSTR^VALM1("Pager #:",X,51,8)
+26 SET X=$$SETSTR^VALM1($SELECT(($PIECE(SD(.13),U,5)'=""):$PIECE(SD(.13),U,5),1:"UNANSWERED"),X,SDSECCOL,20)
End DoDot:1
+27 DO SET^SDAMEP1(X)
KILL SDPAGFLG
+28 SET X=""
SET X=$$SETSTR^VALM1(CNTRY,X,10,45)
+29 DO SET^SDAMEP1(X)
+30 SET X=""
SET X=$$SETSTR^VALM1("EMAIL ADDRESS:",X,1,14)
+31 SET X=$$SETSTR^VALM1($SELECT(($PIECE(SD(.13),U,3)'=""):$PIECE(SD(.13),U,3),1:"UNANSWERED"),X,SDFSTCOL,45)
+32 DO SET^SDAMEP1(X)
PTEXP ; Radiation and Status
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Radiation Exposure:",X,1,19)
+3 SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($PIECE(SD(.321),U,3)),X,21,7)
+4 SET X=$$SETSTR^VALM1("Status:",X,52,7)
+5 SET A=$SELECT("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2))
SET SDST=$SELECT('A:"IN",1:"")_"ACTIVE "
SET SDSTA=$SELECT("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",1:"INPATIENT")
+6 IF '$DATA(^DGPM("C",DFN))
SET SDST="NO INPT./LOD. ACT."
SET SDSTA=""
+7 SET X=$$SETSTR^VALM1(SDST_SDSTA,X,SDSECCOL,20)
+8 DO SET^SDAMEP1(X)
PTPOW ; Prisoner of War Info and Last Admission Date
+1 ;
+2 SET X=""
SET X=$$SETSTR^VALM1("Prisoner of War:",X,4,16)
+3 SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($PIECE(SD(.52),U,5)),X,21,7)
+4 SET X=$$SETSTR^VALM1("Last Admit/Lodger Date:",X,36,23)
+5 IF +DGPMVI(13,1)
SET X=$$SETSTR^VALM1($$FTIME^VALM1(+DGPMVI(13,1)),X,SDSECCOL,18)
+6 DO SET^SDAMEP1(X)
PTAO ; Agent Orange Exposure and Last Discharge Date
+1 SET X=""
SET X=$$SETSTR^VALM1("AO Exp/Loc:",X,9,11)
+2 ;SD*5.3*777 - Add BWN
SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($PIECE(SD(.321),U,2))_$SELECT($PIECE(SD(.321),U,13)="V":"/VIET",$PIECE(SD(.321),U,13)="K":"/DMZ",$PIECE(SD(.321),U,13)="O":"/OTH",$PIECE(SD(.321),U,13)="B":"/BWN",1:""),X,21,14)
+3 SET X=$$SETSTR^VALM1("Last Disch./Lodger Date:",X,35,24)
+4 SET SDDISCH=+$GET(^DGPM(+DGPMVI(17),0))
+5 IF +SDDISCH
SET X=$$SETSTR^VALM1($$FTIME^VALM1(SDDISCH),X,SDSECCOL,18)
+6 DO SET^SDAMEP1(X)
CV ;Combat vet
+1 SET X=""
SET X=$$SETSTR^VALM1("Combat Veteran:",X,5,15)
+2 SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($SELECT($PIECE(SD("CV"),U,1)>0:"Y",1:"N")),X,21,7)
+3 SET X=$$SETSTR^VALM1("Combat Veteran End Date:",X,35,24)
+4 IF $PIECE(SD("CV"),U,1)>0
Begin DoDot:1
+5 SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SD("CV"),U,2)),X,SDSECCOL,18)
End DoDot:1
+6 IF '$TEST
SET X=$$SETSTR^VALM1("N/A",X,SDSECCOL,3)
+7 DO SET^SDAMEP1(X)
SHAD ;PROJ 112/SHAD
+1 SET X=""
SET X=$$SETSTR^VALM1("PROJ 112/SHAD:",X,6,14)
+2 SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($SELECT($PIECE(SD(.321),U,15)>0:"Y",1:"N")),X,21,7)
SWASIA ;SW Asia
+1 SET X=$$SETSTR^VALM1("SW Asia Conditions:",X,40,19)
+2 SET X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($PIECE(SD(.322),U,13)),X,SDSECCOL,20)
+3 DO SET^SDAMEP1(X)
+4 DO SET^SDAMEP1("")
+5 QUIT
