VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ;14 Nov 2018 4:20 PM
;;5.3;Registration;**414,505,627,697,797,876,937,944,974**;Aug 13, 1993;Build 2
;Reference to ^MPIF(984.9,"C" supported by IA #3298
;
CMORHIS ;Find CMOR History
I '$O(^DPT(DFN,"MPICMOR",0)) G CMORCHG
I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
.S LNQ=22 D SS^VAFCPDAT Q:QFLG
.W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
D CHISHDR
S HIS=0 F S HIS=$O(^DPT(DFN,"MPICMOR",HIS)) Q:'HIS D Q:QFLG
.S DIC=2,DR="993",DR(2.0993)=".01;3",DA=DFN,DA(2.0993)=HIS
.S DIQ(0)="E",DIQ="CMORNODE"
.D EN^DIQ1 K DIC,DR,DA,DIQ
.S HISCMOR=$G(CMORNODE(2.0993,HIS,.01,"E"))
.I +HISCMOR S HISCMOR=$$GET1^DIQ(4,HISCMOR,.01)
.S CHGDT=$G(CMORNODE(2.0993,HIS,3,"E"))
.I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
..S LNQ=22 D SS^VAFCPDAT Q:QFLG
..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CHISHDR
.W !,$P(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR
;
CMORCHG ;Find CMOR change request
I '$O(^MPIF(984.9,"C",DFN,0)) G EXT
I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
.S LNQ=22 D SS^VAFCPDAT Q:QFLG
.W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
D CCHGHDR
S CHG=0 F S CHG=$O(^MPIF(984.9,"C",DFN,CHG)) Q:'CHG D Q:QFLG
.S DIC=984.9,DA=CHG,DR=".01;.03;.06;.07;.08;1.03",DIQ="CHGNODE"
.S DIQ(0)="EI" D EN^DIQ1 K DIC,DA,DR,DIQ
.S CHGNUM=$G(CHGNODE(984.9,CHG,.01,"E"))
.S CHGDT=$G(CHGNODE(984.9,CHG,.03,"E"))
.S TMSG=$G(CHGNODE(984.9,CHG,.08,"E"))
.S TREQ=$G(CHGNODE(984.9,CHG,1.03,"E"))
.S SITE=$G(CHGNODE(984.9,CHG,.07,"E"))
.S STATUS=$G(CHGNODE(984.9,CHG,.06,"E"))
.I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
..S LNQ=22 D SS^VAFCPDAT Q:QFLG
..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CCHGHDR
.W !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT
.W !?4,"Type of Request: ",TREQ," ",SITE
.W !?4,"Status : ",STATUS,!
;
EXT ;Extended patient demographic data
I $E(IOST,1,2)="C-" D Q:QFLG
.S LNQ=22 D SS^VAFCPDAT Q:QFLG
.W @IOF
I QFLG=1 G QUIT^VAFCPDAT
W !!,"Additional DPT Data for: ",NAME," (DFN #",DFN,")",!,LN2
S DA=DFN,DIC=2,DIQ="XDATA",DIQ(0)="EI"
;Story 513046 (elz) place of birth prov and country
S DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525;391;.0931;.0932" ;**876 - MVI_3432 (cml)
N COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW,NODE,MSD,PATTYPE,POBP,POBC ;**876 - MVI_3432 (cml)
D EN^DIQ1 K DIC,DA,DR,DIQ
S COB=$G(XDATA(2,DFN,.092,"E")),SOB=$G(XDATA(2,DFN,.093,"E"))
S FILEDT=$G(XDATA(2,DFN,.097,"E")),FNM=$G(XDATA(2,DFN,.2401,"E"))
S MNM=$G(XDATA(2,DFN,.2402,"E")),MMNM=$G(XDATA(2,DFN,.2403,"E"))
S NOK=$G(XDATA(2,DFN,.211,"E")),DESIG=$G(XDATA(2,DFN,.341,"E"))
S EMER=$G(XDATA(2,DFN,.331,"E"))
S ELIG=$G(XDATA(2,DFN,.361,"E")),VET=$G(XDATA(2,DFN,1901,"E"))
S SRVBR=$G(XDATA(2,DFN,.325,"E")),SRVNUM=$G(XDATA(2,DFN,.328,"E"))
S SRVEDT=$G(XDATA(2,DFN,.326,"E")),SRVSDT=$G(XDATA(2,DFN,.327,"E"))
S MARS=$G(XDATA(2,DFN,.05,"E")),RELP=$G(XDATA(2,DFN,.08,"E"))
S POSRVC=$G(XDATA(2,DFN,.323,"E")),SRVCPCT=$G(XDATA(2,DFN,.302,"E"))
S NOKN=$G(XDATA(2,DFN,.219,"E")),POW=$G(XDATA(2,DFN,.525,"E"))
S PATTYPE=$G(XDATA(2,DFN,391,"E")) ;**876 - MVI_3432 (cml)
S POBC=$G(XDATA(2,DFN,.0931,"I")) ;Story 513046 (elz)
S POBP=$G(XDATA(2,DFN,.0932,"E")) ;Story 513046 (elz)
;
W !,"PLACE OF BIRTH [CITY]",?31,": ",COB
W:'$L(POBP) !,"PLACE OF BIRTH [STATE]",?31,": ",SOB
W:$L(POBP) !,"PLACE OF BIRTH PROVINCE",?31,": ",POBP ;Story 513046 (elz)
W !,"PLACE OF BIRTH COUNTRY",?31,": ",$S(POBC:$$GET1^DIQ(779.004,POBC_",",2),1:"") ; Story 513046 (elz)
W !,"FATHER'S NAME",?31,": ",FNM
W !,"MOTHER'S NAME",?31,": ",MNM
W !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM
W !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK
W !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN
W !,"NAME OF DESIGNEE",?31,": ",DESIG
W !,"EMERGENCY NAME",?31,": ",EMER
W !,"MARITAL STATUS",?31,": ",MARS
W !,"RELIGIOUS PREFERENCE",?31,": ",RELP
;
D DEM^VADPT
;ETHNICITY info
I $G(VADM(11,1)) W !,"ETHNICITY INFORMATION",?31,": ",$P(VADM(11,1),"^",2)
;
;RACE multiple
I $O(VADM(12,0)) D
.W !,"RACE INFORMATION (multiple):"
.S RACEMUL=0 F S RACEMUL=$O(VADM(12,RACEMUL)) Q:'RACEMUL W !?3,$P(VADM(12,RACEMUL),"^",2)
;
W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG
W !,"PATIENT TYPE",?31,": ",PATTYPE ;**876 - MVI_3432 (cml)
W !,"VETERAN (Y/N)?",?31,": ",VET
W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT
W !,"PERIOD OF SERVICE",?31,": ",POSRVC
W !,"POW STATUS INDICATED?",?31,": ",POW
;
;Military Service Data multiple
I $O(^DPT(DFN,.3216,0)) D
.W !,"MILITARY SERVICE (multiple):"
.W !,"Service Branch Service # Entry DT Separation DT"
.W !,"---------------------------------------------------------"
.K MSDARR
.S MSD=0 F S MSD=$O(^DPT(DFN,.3216,MSD)) Q:'MSD D
..S NODE=^DPT(DFN,.3216,MSD,0)
..S SRVEDT=$P(NODE,"^"),SRVSDT=$P(NODE,"^",2),SRVNUM=$P(NODE,"^",5),SRVBR=$$GET1^DIQ(23,$P(NODE,"^",3),.01)
..S MSDARR(-SRVEDT)=SRVSDT_"^"_SRVNUM_"^"_SRVBR
.S SRVEDT="" F S SRVEDT=$O(MSDARR(SRVEDT)) Q:'SRVEDT D
..W !?0,$P(MSDARR(SRVEDT),"^",3),?17,$P(MSDARR(SRVEDT),"^",2),?29,$$FMTE^XLFDT($P(SRVEDT,"-",2)),?44,$$FMTE^XLFDT(+MSDARR(SRVEDT))
;
;**974,Story 841921 (mko): Name Components
N NCIEN
S NCIEN=+$P($G(^DPT(DFN,"NAME")),"^")
I NCIEN W !,"PATIENT NAME COMPONENTS:" D NC(NCIEN,3,22)
;
;ALIAS multiple
I $O(^DPT(DFN,.01,0)) D
.W !,"ALIAS (multiple):"
.S ALIAS=0 F S ALIAS=$O(^DPT(DFN,.01,ALIAS)) Q:'ALIAS D
..;**974,Story 841921 (mko): Show the entire Alias Name rather than truncating to 30
..W !?3,$P(^DPT(DFN,.01,ALIAS,0),"^"),?40,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2)
..;**974,Story 841921 (mko): Alias Name Components
..D NC(+$P($G(^DPT(DFN,.01,ALIAS,0)),"^",3),6,25)
;
; Preferred Name
I $G(DNODE(2,DFN,.2405,"E"))]"" W !,"PREFERRED NAME",?31,": ",DNODE(2,DFN,.2405,"E")
;
W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT
;
K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM,MSDARR
Q
;
NC(NCIEN,TAB1,TAB2) ;**974,Story 841921 (mko): Get and write Name Components
Q:'$G(NCIEN)
S TAB1="?"_+$G(TAB1),TAB2="?"_+$G(TAB2)
N DIERR,DIHELP,DIMSG,NC,NCIENS,TARG,MSG
S NCIENS=NCIEN_","
D GETS^DIQ(20,NCIENS,"1;2;3;5","I","TARG","MSG") Q:$D(DIERR)
S NC=$G(TARG(20,NCIENS,1,"I")) W:NC]"" !,@TAB1,"Family (Last) Name",@TAB2,": "_NC
S NC=$G(TARG(20,NCIENS,2,"I")) W:NC]"" !,@TAB1,"Given (First) Name",@TAB2,": "_NC
S NC=$G(TARG(20,NCIENS,3,"I")) W:NC]"" !,@TAB1,"Middle Name",@TAB2,": "_NC
S NC=$G(TARG(20,NCIENS,5,"I")) W:NC]"" !,@TAB1,"Suffix",@TAB2,": "_NC
Q
;
CHISHDR W !!,"CMOR History:",!,"--------------"
Q
CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCPDT2 6936 printed Oct 16, 2024@19:02:40 Page 2
VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ;14 Nov 2018 4:20 PM
+1 ;;5.3;Registration;**414,505,627,697,797,876,937,944,974**;Aug 13, 1993;Build 2
+2 ;Reference to ^MPIF(984.9,"C" supported by IA #3298
+3 ;
CMORHIS ;Find CMOR History
+1 IF '$ORDER(^DPT(DFN,"MPICMOR",0))
GOTO CMORCHG
+2 IF $Y+4>IOSL&($EXTRACT(IOST,1,2)="C-")
Begin DoDot:1
+3 SET LNQ=22
DO SS^VAFCPDAT
if QFLG
QUIT
+4 WRITE @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
End DoDot:1
if QFLG
QUIT
+5 DO CHISHDR
+6 SET HIS=0
FOR
SET HIS=$ORDER(^DPT(DFN,"MPICMOR",HIS))
if 'HIS
QUIT
Begin DoDot:1
+7 SET DIC=2
SET DR="993"
SET DR(2.0993)=".01;3"
SET DA=DFN
SET DA(2.0993)=HIS
+8 SET DIQ(0)="E"
SET DIQ="CMORNODE"
+9 DO EN^DIQ1
KILL DIC,DR,DA,DIQ
+10 SET HISCMOR=$GET(CMORNODE(2.0993,HIS,.01,"E"))
+11 IF +HISCMOR
SET HISCMOR=$$GET1^DIQ(4,HISCMOR,.01)
+12 SET CHGDT=$GET(CMORNODE(2.0993,HIS,3,"E"))
+13 IF $Y+3>IOSL&($EXTRACT(IOST,1,2)="C-")
Begin DoDot:2
+14 SET LNQ=22
DO SS^VAFCPDAT
if QFLG
QUIT
+15 WRITE @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
DO CHISHDR
End DoDot:2
if QFLG
QUIT
+16 WRITE !,$PIECE(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR
End DoDot:1
if QFLG
QUIT
+17 ;
CMORCHG ;Find CMOR change request
+1 IF '$ORDER(^MPIF(984.9,"C",DFN,0))
GOTO EXT
+2 IF $Y+4>IOSL&($EXTRACT(IOST,1,2)="C-")
Begin DoDot:1
+3 SET LNQ=22
DO SS^VAFCPDAT
if QFLG
QUIT
+4 WRITE @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
End DoDot:1
if QFLG
QUIT
+5 DO CCHGHDR
+6 SET CHG=0
FOR
SET CHG=$ORDER(^MPIF(984.9,"C",DFN,CHG))
if 'CHG
QUIT
Begin DoDot:1
+7 SET DIC=984.9
SET DA=CHG
SET DR=".01;.03;.06;.07;.08;1.03"
SET DIQ="CHGNODE"
+8 SET DIQ(0)="EI"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+9 SET CHGNUM=$GET(CHGNODE(984.9,CHG,.01,"E"))
+10 SET CHGDT=$GET(CHGNODE(984.9,CHG,.03,"E"))
+11 SET TMSG=$GET(CHGNODE(984.9,CHG,.08,"E"))
+12 SET TREQ=$GET(CHGNODE(984.9,CHG,1.03,"E"))
+13 SET SITE=$GET(CHGNODE(984.9,CHG,.07,"E"))
+14 SET STATUS=$GET(CHGNODE(984.9,CHG,.06,"E"))
+15 IF $Y+4>IOSL&($EXTRACT(IOST,1,2)="C-")
Begin DoDot:2
+16 SET LNQ=22
DO SS^VAFCPDAT
if QFLG
QUIT
+17 WRITE @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
DO CCHGHDR
End DoDot:2
if QFLG
QUIT
+18 WRITE !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT
+19 WRITE !?4,"Type of Request: ",TREQ," ",SITE
+20 WRITE !?4,"Status : ",STATUS,!
End DoDot:1
if QFLG
QUIT
+21 ;
EXT ;Extended patient demographic data
+1 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 SET LNQ=22
DO SS^VAFCPDAT
if QFLG
QUIT
+3 WRITE @IOF
End DoDot:1
if QFLG
QUIT
+4 IF QFLG=1
GOTO QUIT^VAFCPDAT
+5 WRITE !!,"Additional DPT Data for: ",NAME," (DFN #",DFN,")",!,LN2
+6 SET DA=DFN
SET DIC=2
SET DIQ="XDATA"
SET DIQ(0)="EI"
+7 ;Story 513046 (elz) place of birth prov and country
+8 ;**876 - MVI_3432 (cml)
SET DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525;391;.0931;.0932"
+9 ;**876 - MVI_3432 (cml)
NEW COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW,NODE,MSD,PATTYPE,POBP,POBC
+10 DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+11 SET COB=$GET(XDATA(2,DFN,.092,"E"))
SET SOB=$GET(XDATA(2,DFN,.093,"E"))
+12 SET FILEDT=$GET(XDATA(2,DFN,.097,"E"))
SET FNM=$GET(XDATA(2,DFN,.2401,"E"))
+13 SET MNM=$GET(XDATA(2,DFN,.2402,"E"))
SET MMNM=$GET(XDATA(2,DFN,.2403,"E"))
+14 SET NOK=$GET(XDATA(2,DFN,.211,"E"))
SET DESIG=$GET(XDATA(2,DFN,.341,"E"))
+15 SET EMER=$GET(XDATA(2,DFN,.331,"E"))
+16 SET ELIG=$GET(XDATA(2,DFN,.361,"E"))
SET VET=$GET(XDATA(2,DFN,1901,"E"))
+17 SET SRVBR=$GET(XDATA(2,DFN,.325,"E"))
SET SRVNUM=$GET(XDATA(2,DFN,.328,"E"))
+18 SET SRVEDT=$GET(XDATA(2,DFN,.326,"E"))
SET SRVSDT=$GET(XDATA(2,DFN,.327,"E"))
+19 SET MARS=$GET(XDATA(2,DFN,.05,"E"))
SET RELP=$GET(XDATA(2,DFN,.08,"E"))
+20 SET POSRVC=$GET(XDATA(2,DFN,.323,"E"))
SET SRVCPCT=$GET(XDATA(2,DFN,.302,"E"))
+21 SET NOKN=$GET(XDATA(2,DFN,.219,"E"))
SET POW=$GET(XDATA(2,DFN,.525,"E"))
+22 ;**876 - MVI_3432 (cml)
SET PATTYPE=$GET(XDATA(2,DFN,391,"E"))
+23 ;Story 513046 (elz)
SET POBC=$GET(XDATA(2,DFN,.0931,"I"))
+24 ;Story 513046 (elz)
SET POBP=$GET(XDATA(2,DFN,.0932,"E"))
+25 ;
+26 WRITE !,"PLACE OF BIRTH [CITY]",?31,": ",COB
+27 if '$LENGTH(POBP)
WRITE !,"PLACE OF BIRTH [STATE]",?31,": ",SOB
+28 ;Story 513046 (elz)
if $LENGTH(POBP)
WRITE !,"PLACE OF BIRTH PROVINCE",?31,": ",POBP
+29 ; Story 513046 (elz)
WRITE !,"PLACE OF BIRTH COUNTRY",?31,": ",$SELECT(POBC:$$GET1^DIQ(779.004,POBC_",",2),1:"")
+30 WRITE !,"FATHER'S NAME",?31,": ",FNM
+31 WRITE !,"MOTHER'S NAME",?31,": ",MNM
+32 WRITE !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM
+33 WRITE !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK
+34 WRITE !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN
+35 WRITE !,"NAME OF DESIGNEE",?31,": ",DESIG
+36 WRITE !,"EMERGENCY NAME",?31,": ",EMER
+37 WRITE !,"MARITAL STATUS",?31,": ",MARS
+38 WRITE !,"RELIGIOUS PREFERENCE",?31,": ",RELP
+39 ;
+40 DO DEM^VADPT
+41 ;ETHNICITY info
+42 IF $GET(VADM(11,1))
WRITE !,"ETHNICITY INFORMATION",?31,": ",$PIECE(VADM(11,1),"^",2)
+43 ;
+44 ;RACE multiple
+45 IF $ORDER(VADM(12,0))
Begin DoDot:1
+46 WRITE !,"RACE INFORMATION (multiple):"
+47 SET RACEMUL=0
FOR
SET RACEMUL=$ORDER(VADM(12,RACEMUL))
if 'RACEMUL
QUIT
WRITE !?3,$PIECE(VADM(12,RACEMUL),"^",2)
End DoDot:1
+48 ;
+49 WRITE !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG
+50 ;**876 - MVI_3432 (cml)
WRITE !,"PATIENT TYPE",?31,": ",PATTYPE
+51 WRITE !,"VETERAN (Y/N)?",?31,": ",VET
+52 WRITE !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT
+53 WRITE !,"PERIOD OF SERVICE",?31,": ",POSRVC
+54 WRITE !,"POW STATUS INDICATED?",?31,": ",POW
+55 ;
+56 ;Military Service Data multiple
+57 IF $ORDER(^DPT(DFN,.3216,0))
Begin DoDot:1
+58 WRITE !,"MILITARY SERVICE (multiple):"
+59 WRITE !,"Service Branch Service # Entry DT Separation DT"
+60 WRITE !,"---------------------------------------------------------"
+61 KILL MSDARR
+62 SET MSD=0
FOR
SET MSD=$ORDER(^DPT(DFN,.3216,MSD))
if 'MSD
QUIT
Begin DoDot:2
+63 SET NODE=^DPT(DFN,.3216,MSD,0)
+64 SET SRVEDT=$PIECE(NODE,"^")
SET SRVSDT=$PIECE(NODE,"^",2)
SET SRVNUM=$PIECE(NODE,"^",5)
SET SRVBR=$$GET1^DIQ(23,$PIECE(NODE,"^",3),.01)
+65 SET MSDARR(-SRVEDT)=SRVSDT_"^"_SRVNUM_"^"_SRVBR
End DoDot:2
+66 SET SRVEDT=""
FOR
SET SRVEDT=$ORDER(MSDARR(SRVEDT))
if 'SRVEDT
QUIT
Begin DoDot:2
+67 WRITE !?0,$PIECE(MSDARR(SRVEDT),"^",3),?17,$PIECE(MSDARR(SRVEDT),"^",2),?29,$$FMTE^XLFDT($PIECE(SRVEDT,"-",2)),?44,$$FMTE^XLFDT(+MSDARR(SRVEDT))
End DoDot:2
End DoDot:1
+68 ;
+69 ;**974,Story 841921 (mko): Name Components
+70 NEW NCIEN
+71 SET NCIEN=+$PIECE($GET(^DPT(DFN,"NAME")),"^")
+72 IF NCIEN
WRITE !,"PATIENT NAME COMPONENTS:"
DO NC(NCIEN,3,22)
+73 ;
+74 ;ALIAS multiple
+75 IF $ORDER(^DPT(DFN,.01,0))
Begin DoDot:1
+76 WRITE !,"ALIAS (multiple):"
+77 SET ALIAS=0
FOR
SET ALIAS=$ORDER(^DPT(DFN,.01,ALIAS))
if 'ALIAS
QUIT
Begin DoDot:2
+78 ;**974,Story 841921 (mko): Show the entire Alias Name rather than truncating to 30
+79 WRITE !?3,$PIECE(^DPT(DFN,.01,ALIAS,0),"^"),?40,"SSN: "_$PIECE($GET(^DPT(DFN,.01,ALIAS,0)),"^",2)
+80 ;**974,Story 841921 (mko): Alias Name Components
+81 DO NC(+$PIECE($GET(^DPT(DFN,.01,ALIAS,0)),"^",3),6,25)
End DoDot:2
End DoDot:1
+82 ;
+83 ; Preferred Name
+84 IF $GET(DNODE(2,DFN,.2405,"E"))]""
WRITE !,"PREFERRED NAME",?31,": ",DNODE(2,DFN,.2405,"E")
+85 ;
+86 WRITE !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT
+87 ;
+88 KILL ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM,MSDARR
+89 QUIT
+90 ;
NC(NCIEN,TAB1,TAB2) ;**974,Story 841921 (mko): Get and write Name Components
+1 if '$GET(NCIEN)
QUIT
+2 SET TAB1="?"_+$GET(TAB1)
SET TAB2="?"_+$GET(TAB2)
+3 NEW DIERR,DIHELP,DIMSG,NC,NCIENS,TARG,MSG
+4 SET NCIENS=NCIEN_","
+5 DO GETS^DIQ(20,NCIENS,"1;2;3;5","I","TARG","MSG")
if $DATA(DIERR)
QUIT
+6 SET NC=$GET(TARG(20,NCIENS,1,"I"))
if NC]""
WRITE !,@TAB1,"Family (Last) Name",@TAB2,": "_NC
+7 SET NC=$GET(TARG(20,NCIENS,2,"I"))
if NC]""
WRITE !,@TAB1,"Given (First) Name",@TAB2,": "_NC
+8 SET NC=$GET(TARG(20,NCIENS,3,"I"))
if NC]""
WRITE !,@TAB1,"Middle Name",@TAB2,": "_NC
+9 SET NC=$GET(TARG(20,NCIENS,5,"I"))
if NC]""
WRITE !,@TAB1,"Suffix",@TAB2,": "_NC
+10 QUIT
+11 ;
CHISHDR WRITE !!,"CMOR History:",!,"--------------"
+1 QUIT
CCHGHDR WRITE !!,"CMOR Change Request History:",!,"----------------------------"
+1 QUIT
