Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCPDT2

VAFCPDT2.m

Go to the documentation of this file. 
  1. 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
  1.  ;Reference to ^MPIF(984.9,"C" supported by IA #3298
  1.  ;
  1. CMORHIS ;Find CMOR History
  1.  I '$O(^DPT(DFN,"MPICMOR",0)) G CMORCHG
  1.  I $Y+4>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  .S LNQ=22 D SS^VAFCPDAT Q:QFLG
  1.  .W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2
  1.  D CHISHDR
  1.  S HIS=0 F  S HIS=$O(^DPT(DFN,"MPICMOR",HIS)) Q:'HIS  D  Q:QFLG
  1.  .S DIC=2,DR="993",DR(2.0993)=".01;3",DA=DFN,DA(2.0993)=HIS
  1.  .S DIQ(0)="E",DIQ="CMORNODE"
  1.  .D EN^DIQ1 K DIC,DR,DA,DIQ
  1.  .S HISCMOR=$G(CMORNODE(2.0993,HIS,.01,"E"))
  1.  .I +HISCMOR S HISCMOR=$$GET1^DIQ(4,HISCMOR,.01)
  1.  .S CHGDT=$G(CMORNODE(2.0993,HIS,3,"E"))
  1.  .I $Y+3>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  ..S LNQ=22 D SS^VAFCPDAT Q:QFLG
  1.  ..W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2 D CHISHDR
  1.  .W !,$P(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR
  1.  ;
  1. CMORCHG ;Find CMOR change request
  1.  I '$O(^MPIF(984.9,"C",DFN,0)) G EXT
  1.  I $Y+4>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  .S LNQ=22 D SS^VAFCPDAT Q:QFLG
  1.  .W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2
  1.  D CCHGHDR
  1.  S CHG=0 F  S CHG=$O(^MPIF(984.9,"C",DFN,CHG)) Q:'CHG  D  Q:QFLG
  1.  .S DIC=984.9,DA=CHG,DR=".01;.03;.06;.07;.08;1.03",DIQ="CHGNODE"
  1.  .S DIQ(0)="EI" D EN^DIQ1 K DIC,DA,DR,DIQ
  1.  .S CHGNUM=$G(CHGNODE(984.9,CHG,.01,"E"))
  1.  .S CHGDT=$G(CHGNODE(984.9,CHG,.03,"E"))
  1.  .S TMSG=$G(CHGNODE(984.9,CHG,.08,"E"))
  1.  .S TREQ=$G(CHGNODE(984.9,CHG,1.03,"E"))
  1.  .S SITE=$G(CHGNODE(984.9,CHG,.07,"E"))
  1.  .S STATUS=$G(CHGNODE(984.9,CHG,.06,"E"))
  1.  .I $Y+4>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  ..S LNQ=22 D SS^VAFCPDAT Q:QFLG
  1.  ..W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2 D CCHGHDR
  1.  .W !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT
  1.  .W !?4,"Type of Request: ",TREQ," ",SITE
  1.  .W !?4,"Status : ",STATUS,!
  1.  ;
  1. EXT ;Extended patient demographic data
  1.  I $E(IOST,1,2)="C-" D  Q:QFLG
  1.  .S LNQ=22 D SS^VAFCPDAT Q:QFLG
  1.  .W @IOF
  1.  I QFLG=1 G QUIT^VAFCPDAT
  1.  W !!,"Additional DPT Data for: ",NAME,"  (DFN #",DFN,")",!,LN2
  1.  S DA=DFN,DIC=2,DIQ="XDATA",DIQ(0)="EI"
  1.  ;Story 513046 (elz) place of birth prov and country
  1.  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)
  1.  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)
  1.  D EN^DIQ1 K DIC,DA,DR,DIQ
  1.  S COB=$G(XDATA(2,DFN,.092,"E")),SOB=$G(XDATA(2,DFN,.093,"E"))
  1.  S FILEDT=$G(XDATA(2,DFN,.097,"E")),FNM=$G(XDATA(2,DFN,.2401,"E"))
  1.  S MNM=$G(XDATA(2,DFN,.2402,"E")),MMNM=$G(XDATA(2,DFN,.2403,"E"))
  1.  S NOK=$G(XDATA(2,DFN,.211,"E")),DESIG=$G(XDATA(2,DFN,.341,"E"))
  1.  S EMER=$G(XDATA(2,DFN,.331,"E"))
  1.  S ELIG=$G(XDATA(2,DFN,.361,"E")),VET=$G(XDATA(2,DFN,1901,"E"))
  1.  S SRVBR=$G(XDATA(2,DFN,.325,"E")),SRVNUM=$G(XDATA(2,DFN,.328,"E"))
  1.  S SRVEDT=$G(XDATA(2,DFN,.326,"E")),SRVSDT=$G(XDATA(2,DFN,.327,"E"))
  1.  S MARS=$G(XDATA(2,DFN,.05,"E")),RELP=$G(XDATA(2,DFN,.08,"E"))
  1.  S POSRVC=$G(XDATA(2,DFN,.323,"E")),SRVCPCT=$G(XDATA(2,DFN,.302,"E"))
  1.  S NOKN=$G(XDATA(2,DFN,.219,"E")),POW=$G(XDATA(2,DFN,.525,"E"))
  1.  S PATTYPE=$G(XDATA(2,DFN,391,"E"))  ;**876 - MVI_3432 (cml)
  1.  S POBC=$G(XDATA(2,DFN,.0931,"I")) ;Story 513046 (elz)
  1.  S POBP=$G(XDATA(2,DFN,.0932,"E")) ;Story 513046 (elz)
  1.  ;
  1.  W !,"PLACE OF BIRTH [CITY]",?31,": ",COB
  1.  W:'$L(POBP) !,"PLACE OF BIRTH [STATE]",?31,": ",SOB
  1.  W:$L(POBP) !,"PLACE OF BIRTH PROVINCE",?31,": ",POBP ;Story 513046 (elz)
  1.  W !,"PLACE OF BIRTH COUNTRY",?31,": ",$S(POBC:$$GET1^DIQ(779.004,POBC_",",2),1:"") ; Story 513046 (elz)
  1.  W !,"FATHER'S NAME",?31,": ",FNM
  1.  W !,"MOTHER'S NAME",?31,": ",MNM
  1.  W !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM
  1.  W !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK
  1.  W !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN
  1.  W !,"NAME OF DESIGNEE",?31,": ",DESIG
  1.  W !,"EMERGENCY NAME",?31,": ",EMER
  1.  W !,"MARITAL STATUS",?31,": ",MARS
  1.  W !,"RELIGIOUS PREFERENCE",?31,": ",RELP
  1.  ;
  1.  D DEM^VADPT
  1.  ;ETHNICITY info
  1.  I $G(VADM(11,1)) W !,"ETHNICITY INFORMATION",?31,": ",$P(VADM(11,1),"^",2)
  1.  ;
  1.  ;RACE multiple
  1.  I $O(VADM(12,0)) D
  1.  .W !,"RACE INFORMATION (multiple):"
  1.  .S RACEMUL=0 F  S RACEMUL=$O(VADM(12,RACEMUL)) Q:'RACEMUL  W !?3,$P(VADM(12,RACEMUL),"^",2)
  1.  ;
  1.  W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG
  1.  W !,"PATIENT TYPE",?31,": ",PATTYPE  ;**876 - MVI_3432 (cml)
  1.  W !,"VETERAN (Y/N)?",?31,": ",VET
  1.  W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT
  1.  W !,"PERIOD OF SERVICE",?31,": ",POSRVC
  1.  W !,"POW STATUS INDICATED?",?31,": ",POW
  1.  ;
  1.  ;Military Service Data multiple
  1.  I $O(^DPT(DFN,.3216,0)) D
  1.  .W !,"MILITARY SERVICE (multiple):"
  1.  .W !,"Service Branch   Service #   Entry DT       Separation DT"
  1.  .W !,"---------------------------------------------------------"
  1.  .K MSDARR
  1.  .S MSD=0 F  S MSD=$O(^DPT(DFN,.3216,MSD)) Q:'MSD  D
  1.  ..S NODE=^DPT(DFN,.3216,MSD,0)
  1.  ..S SRVEDT=$P(NODE,"^"),SRVSDT=$P(NODE,"^",2),SRVNUM=$P(NODE,"^",5),SRVBR=$$GET1^DIQ(23,$P(NODE,"^",3),.01)
  1.  ..S MSDARR(-SRVEDT)=SRVSDT_"^"_SRVNUM_"^"_SRVBR
  1.  .S SRVEDT="" F  S SRVEDT=$O(MSDARR(SRVEDT)) Q:'SRVEDT  D
  1.  ..W !?0,$P(MSDARR(SRVEDT),"^",3),?17,$P(MSDARR(SRVEDT),"^",2),?29,$$FMTE^XLFDT($P(SRVEDT,"-",2)),?44,$$FMTE^XLFDT(+MSDARR(SRVEDT))
  1.  ;
  1.  ;**974,Story 841921 (mko): Name Components
  1.  N NCIEN
  1.  S NCIEN=+$P($G(^DPT(DFN,"NAME")),"^")
  1.  I NCIEN W !,"PATIENT NAME COMPONENTS:" D NC(NCIEN,3,22)
  1.  ;
  1.  ;ALIAS multiple
  1.  I $O(^DPT(DFN,.01,0)) D
  1.  .W !,"ALIAS (multiple):"
  1.  .S ALIAS=0 F  S ALIAS=$O(^DPT(DFN,.01,ALIAS)) Q:'ALIAS  D
  1.  ..;**974,Story 841921 (mko): Show the entire Alias Name rather than truncating to 30
  1.  ..W !?3,$P(^DPT(DFN,.01,ALIAS,0),"^"),?40,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2)
  1.  ..;**974,Story 841921 (mko): Alias Name Components
  1.  ..D NC(+$P($G(^DPT(DFN,.01,ALIAS,0)),"^",3),6,25)
  1.  ;
  1.  ; Preferred Name
  1.  I $G(DNODE(2,DFN,.2405,"E"))]"" W !,"PREFERRED NAME",?31,": ",DNODE(2,DFN,.2405,"E")
  1.  ;
  1.  W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT
  1.  ;
  1.  K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM,MSDARR
  1.  Q
  1.  ;
  1. NC(NCIEN,TAB1,TAB2) ;**974,Story 841921 (mko): Get and write Name Components
  1.  Q:'$G(NCIEN)
  1.  S TAB1="?"_+$G(TAB1),TAB2="?"_+$G(TAB2)
  1.  N DIERR,DIHELP,DIMSG,NC,NCIENS,TARG,MSG
  1.  S NCIENS=NCIEN_","
  1.  D GETS^DIQ(20,NCIENS,"1;2;3;5","I","TARG","MSG") Q:$D(DIERR)
  1.  S NC=$G(TARG(20,NCIENS,1,"I")) W:NC]"" !,@TAB1,"Family (Last) Name",@TAB2,": "_NC
  1.  S NC=$G(TARG(20,NCIENS,2,"I")) W:NC]"" !,@TAB1,"Given (First) Name",@TAB2,": "_NC
  1.  S NC=$G(TARG(20,NCIENS,3,"I")) W:NC]"" !,@TAB1,"Middle Name",@TAB2,": "_NC
  1.  S NC=$G(TARG(20,NCIENS,5,"I")) W:NC]"" !,@TAB1,"Suffix",@TAB2,": "_NC
  1.  Q
  1.  ;
  1. CHISHDR W !!,"CMOR History:",!,"--------------"
  1.  Q
  1. CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------"
  1.  Q