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

VAFCPDAT.m

Go to the documentation of this file. 
  1. VAFCPDAT ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ;10/24/02  13:13
  1.  ;;5.3;PIMS;**333,414,474,505,707,1015,1016**;JUN 30, 2012;Build 20
  1.  ;Registration has IA #3299 for MPI/PD to call START^VAFCPDAT
  1.  ;
  1.  ;variable DFN is not NEWed or KILLed in this routine as that variable is passed in
  1.  ;
  1. MAIN ; Entry point with device call
  1.  S NOTRPC=1
  1.  K ZTSAVE S ZTSAVE("DFN")=""
  1.  D EN^XUTMDEVQ("START^VAFCPDAT","Print MPI/PD Patient Data",.ZTSAVE)
  1.  K NOTRPC
  1.  Q
  1.  ;
  1. START ;Entry point without device call, used for RPC calls
  1.  S $P(LN,"=",80)="",$P(LN2,"=",60)="",QFLG=0
  1.  D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
  1.  S SITE=$$SITE^VASITE(),SITENAM=$P(SITE,"^",2),SITENUM=$P(SITE,"^",3),SITEIEN=$P(SITE,"^")
  1.  I +DFN<0 D  Q
  1.  .I $D(NOTRPC) W @IOF,!," "
  1.  .W !,"ICN ",$G(ICN)," does not exist at ",SITENAM,"."
  1.  .W !,"Search date: ",HDT,!,LN
  1.  S DIC=2,DR=".01;.02;.03;.09;.111;.112;.113;.114;.115;.1112;.131;.313;.351;994;.0907;.0906;.121",DA=DFN,DIQ(0)="EI",DIQ="DNODE"  ;**707,712
  1.  N NAME,SSN,DOB,SEX,CLAIM,DOD,ICN,STR1,STR2,STR3,CTY,ST,ZIP,PHN,MBI,SSNVER,PREAS,BAI  ;**707,712
  1.  D EN^DIQ1 K DIC,DR,DA,DIQ
  1.  S NAME=$G(DNODE(2,DFN,.01,"E")),SSN=$G(DNODE(2,DFN,.09,"E"))
  1.  S DOB=$$FMTE^XLFDT($G(DNODE(2,DFN,.03,"I")))
  1.  S MBI=$G(DNODE(2,DFN,994,"I")),MBI=$S(MBI="Y":"YES",MBI="N":"NO",1:"NULL")  ;**707
  1.  S SEX=$G(DNODE(2,DFN,.02,"E")),DOD=$G(DNODE(2,DFN,.351,"E"))
  1.  S CLAIM=$G(DNODE(2,DFN,.313,"E")) S:CLAIM="" CLAIM="None"
  1.  S BAI=$G(DNODE(2,DFN,.121,"E"))  ;**712
  1.  S STR1=$G(DNODE(2,DFN,.111,"E")),STR2=$G(DNODE(2,DFN,.112,"E")),STR3=$G(DNODE(2,DFN,.113,"E"))
  1.  S CTY=$G(DNODE(2,DFN,.114,"E")),ST=$G(DNODE(2,DFN,.115,"E")),ZIP=$G(DNODE(2,DFN,.1112,"E"))
  1.  S PHN=$G(DNODE(2,DFN,.131,"E"))
  1.  S SSNVER=$G(DNODE(2,DFN,.0907,"E"))  ;**707
  1.  S PREAS=$G(DNODE(2,DFN,.0906,"E"))  ;**707
  1.  S MNODE=$$MPINODE^MPIFAPI(DFN) I +MNODE=-1 S MNODE="^^^^^"
  1.  S (ICN,CMOR,SCN,SCORE,SCRDT,DIFF)=""
  1.  S ICN=$P($G(MNODE),"^") S:ICN="" ICN="None"
  1.  S CMOR=$$GET1^DIQ(4,+$P($G(MNODE),"^",3)_",",.01) S:CMOR="" CMOR="None"
  1.  I $E(ICN,1,3)=SITENUM S GOT=0 D
  1.  . I $P($G(MNODE),"^",4)=""!('$D(^DPT("AICNL",1,DFN))) S ICN=ICN_"**"
  1.  ;
  1.  I $D(NOTRPC) W @IOF,!
  1.  W !,"MPI/PD Data for: ",NAME,"  (DFN #",DFN,")"
  1.  ; check for patient sensitivity and user security
  1.  N RESULT,RGSENS,SENSTV,DA,DR,DIC,DIQ,VAFCSEN
  1.  D PTSEC^DGSEC4(.RESULT,DFN,0,"MPI/PD Patient Inquiry^MPI/PD Patient Inquiry")
  1.  I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" G QUIT
  1.  I RESULT(1)>0 W ?50,"***PATIENT MARKED SENSITIVE***"
  1.  I RESULT(1)=3 W !!,"Access not allowed on your own PATIENT (#2) file entry" G QUIT
  1.  I RESULT(1)=4 W !!,"Access denied: Your SSN is not defined" G QUIT
  1.  I RESULT(1)<3 D
  1.  . I RESULT(1)=1 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",2) ;IA #3027
  1.  . I RESULT(1)=2 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",3) ;IA #3027
  1.  W !,"Printed ",HDT," at ",SITENAM,!,LN
  1.  S $Y=$Y+1
  1.  ;next 7 lines modified for **707
  1.  W !,"ICN    : ",ICN,?40,"CMOR: ",CMOR
  1.  W !,"SSN    : ",SSN
  1.  I SSNVER]"" W !?9,"SSN Verification Status: ",SSNVER
  1.  I SSNVER="",PREAS]"" W !?9,"Pseudo SSN Reason: ",PREAS
  1.  I SSNVER]"",PREAS]"" W !?9,"Pseudo SSN Reason      : ",PREAS
  1.  W !,"Sex    : ",SEX
  1.  W !,"Claim #: ",CLAIM
  1.  W !,"Date of Birth: ",DOB
  1.  I DOD]"" W !,"Date of Death: ",DOD
  1.  I MBI]"" W !,"Multiple Birth Indicator: ",MBI  ;**707
  1.  W !,"Address:" I BAI'="" W " (Bad Address Indicator: ",BAI,")"
  1.  I STR1'="" W !?9,STR1
  1.  I STR2'="" W !?9,STR2
  1.  I STR3'="" W !?9,STR3
  1.  I CTY'="" W !?9,$E(CTY,1,20)_", "_$G(ST)_" "_$G(ZIP)
  1.  I PHN'="" W !,"Phone #: ",PHN
  1.  I $G(IOSL)<30&($E(IOST,1,2)="C-") D
  1.  .I $Y>23 D
  1.  ..S DIR(0)="E" D  D ^DIR K DIR I 'Y S QFLG=1
  1.  ...S SS=22-$Y F JJ=1:1:SS W !
  1.  ..S $Y=0
  1.  I QFLG=1 G QUIT
  1.  ;
  1. TF ;List Treating Facilities for this patient
  1.  D TFHDR
  1.  K TFARR
  1.  S TF=0 F  S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF  D
  1.  .S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,0))
  1.  . S DIC="^DGCN(391.91,",DR=".02;.03;.07",DA=TFIEN,DIQ(0)="EI",DIQ="TFDATA"
  1.  . D EN^DIQ1 K DIC,DA,DR,DIQ
  1.  . S INST="",STATION=""
  1.  . S INST=$G(TFDATA(391.91,TFIEN,.02,"I"))
  1.  . I INST'="" D
  1.  .. S DIC=4,DR="99",DA=INST,DIQ(0)="E",DIQ="STA"
  1.  .. D EN^DIQ1 K DIC,DA,DR,DIQ
  1.  .. S STATION=$G(STA(4,INST,99,"E"))
  1.  . S TFNM=$G(TFDATA(391.91,TFIEN,.02,"E"))
  1.  . S LSTDT=$G(TFDATA(391.91,TFIEN,.03,"I")) S:LSTDT="" LSTDT="none found"
  1.  . S LSTSORT=9999999
  1.  . I +LSTDT S LSTSORT=9999999-LSTDT,LSTDT=$$FMTE^XLFDT($E(LSTDT,1,12))
  1.  . S REACODE=$G(TFDATA(391.91,TFIEN,.07,"E")) S REASON="none found"
  1.  . I REACODE'="" D
  1.  .. S DIC="^VAT(391.72,",DIC(0)="Z",X=REACODE D ^DIC K DIC,X
  1.  .. S REASON=$P($G(Y(0)),"^",4)
  1.  . S TFARR(LSTSORT,TFNM)=TFIEN_"^"_REASON_"^"_$G(STATION)_"^"_LSTDT
  1.  I '$D(TFARR) W !,"No Treating Facilities found." G SUB
  1.  S LSTSORT=0 F  S LSTSORT=$O(TFARR(LSTSORT)) Q:'LSTSORT  D  G:QFLG QUIT
  1.  .S TFNM="" F  S TFNM=$O(TFARR(LSTSORT,TFNM)) Q:TFNM=""  D  Q:QFLG
  1.  ..S REASON=$P(TFARR(LSTSORT,TFNM),"^",2)
  1.  ..S STATION=$P(TFARR(LSTSORT,TFNM),"^",3)
  1.  ..S LSTDT=$P(TFARR(LSTSORT,TFNM),"^",4)
  1.  ..I $Y+3>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  ...S LNQ=22 D SS Q:QFLG
  1.  ...W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2 D TFHDR
  1.  ..W !,$E(TFNM,1,20),?22,$G(STATION),?32,LSTDT,?54,REASON
  1. SUB ;removed listing of subscribers for RG*1.0*23
  1. HIS ;find ICN history
  1.  I '$O(^DPT(DFN,"MPIFHIS",0)) G CONT
  1.  ;
  1.  I $Y+4>IOSL&($E(IOST,1,2)="C-") D  G:QFLG QUIT
  1.  .S LNQ=22 D SS Q:QFLG
  1.  .W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2
  1.  D ICNHDR
  1.  S HIS=0 F  S HIS=$O(^DPT(DFN,"MPIFHIS",HIS)) Q:'HIS  D  G:QFLG QUIT
  1.  .S DIC=2,DR="992",DR(2.0992)=".01;3",DA=DFN,DA(2.0992)=HIS
  1.  .S DIQ(0)="E",DIQ="HISNODE"
  1.  .D EN^DIQ1 K DIC,DA,DR,DIQ
  1.  .S HISICN=$G(HISNODE(2.0992,HIS,.01,"E"))
  1.  .S HISDT=$G(HISNODE(2.0992,HIS,3,"E"))
  1.  .I $Y+3>IOSL&($E(IOST,1,2)="C-") D  Q:QFLG
  1.  ..S LNQ=22 D SS Q:QFLG
  1.  ..W @IOF,!,"MPI/PD data for: ",NAME,"  (DFN #",DFN,")",!,LN2 D ICNHDR
  1.  .W !,HISICN I HISDT]"" W "  - changed ",HISDT
  1.  ;
  1. CONT ;Continue to VAFCPDT2 for CMOR data and extended data
  1.  D CMORHIS^VAFCPDT2
  1. DONE ;
  1.  I QFLG G QUIT
  1.  I ($E(IOST,1,2)="C-") S LNQ=24 D SS
  1.  ;
  1. QUIT ;
  1.  K %,CMOR,DIC,DIR,DIRUT,DNODE,GOT,HDT,HIS,HISDT,HISICN,JJ,LIEN,LINST
  1.  K LN,LSTDT,MNODE,REACODE,REASON,SCN,SCORE,SITE,SITEIEN,SITENAM,SITENUM
  1.  K SS,SUBN,SUBARR,TERM,TERMDT,TF,TFARR,TFDATA,TFIEN,TFNM,Y,D,CHG,CHGNODE
  1.  K HISNODE,DIFF,INST,RGDFN,SCRDT,STATION,STA,LN2,NAME,LSTSORT,LNQ,QFLG,MBI
  1.  Q
  1. TFHDR ;
  1.  W !!,"Treating Facilities:",?22,"Station:",?32,"DT Last Treated",?54,"Event Reason"
  1.  W !,"--------------------",?22,"--------",?32,"---------------",?54,"------------"
  1.  Q
  1. ICNHDR W !!,"ICN History:",!,"------------"
  1.  Q
  1.  ;
  1. SS S DIR(0)="E" D  D ^DIR K DIR I 'Y S QFLG=1
  1.  .S SS=LNQ-$Y F JJ=1:1:SS W !
  1.  Q