110 lines
4.6 KiB
Mathematica
110 lines
4.6 KiB
Mathematica
VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 12/3/04 3:50pm
|
|
;;5.3;Registration;**414,505,627,697**;Aug 13, 1993
|
|
;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"
|
|
S DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525"
|
|
N COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW
|
|
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"))
|
|
;
|
|
W !,"PLACE OF BIRTH [CITY]",?31,": ",COB
|
|
W !,"PLACE OF BIRTH [STATE]",?31,": ",SOB
|
|
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
|
|
W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG
|
|
W !,"VETERAN (Y/N)?",?31,": ",VET
|
|
W !,"SERVICE BRANCH [LAST]",?31,": ",SRVBR
|
|
W !,"SERVICE NUMBER [LAST]",?31,": ",SRVNUM
|
|
W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT
|
|
W !,"SERVICE ENTRY DATE [LAST]",?31,": ",SRVEDT
|
|
W !,"SERVICE SEPARATION DATE [LAST]",?31,": ",SRVSDT
|
|
W !,"PERIOD OF SERVICE",?31,": ",POSRVC
|
|
W !,"POW STATUS INDICATED?",?31,": ",POW
|
|
W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT
|
|
;
|
|
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)
|
|
;
|
|
;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 W !?3,$E($P(^DPT(DFN,.01,ALIAS,0),"^"),1,30),?35,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2)
|
|
;
|
|
K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM
|
|
Q
|
|
;
|
|
CHISHDR W !!,"CMOR History:",!,"--------------"
|
|
Q
|
|
CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------"
|
|
Q
|