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

AGEDNAME.m

Go to the documentation of this file. 
  1. AGEDNAME ;IHS/ASDST/GTH - NAME STANDARDIZATION REPORT ;  
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1. TXT ;
  1.  ;;This report is intended to help in Patient identification by searching
  1.  ;;through all the various ways that PtReg collects "NAME"s of patients,
  1.  ;;and checking them for conformance to standard formats for names used
  1.  ;;by the I/T/Us:
  1.  ;;     1...Use from 3 to 30 letters
  1.  ;;     2...a COMMA MUST FOLLOW THE LAST NAME
  1.  ;;     3...If "JR" or "II", etc, is included, follow the form
  1.  ;;         SMITH,JOHN MARK,JR.
  1.  ;;     4...NO SPACES after commas.
  1.  ;;The following name fields are checked:
  1.  ;; PATIENT NAME, EMERGENCY CONTACT, FATHER'S NAME, MOTHER'S MAIDEN
  1.  ;; NAME, OTHER NAME (ALIASES), NAME OF INSURED (MCD), NAME OF POLICY
  1.  ;; HOLDER, NAME OF INSURED (PVT), and NEXT OF KIN.
  1.  ;;  
  1.  ;;Deleted or Merge'd patients are not checked.
  1.  ;;###
  1. TXT1 ;
  1.  ;;In the following report, the value of FIELD indicates where to go in
  1.  ;;the PtReg application to correct the VALUE.  Here's the fields that
  1.  ;;are checked, and corresponding locations in RPMS PtReg, by page number
  1.  ;;and field number that are used on the "Patient Registration" option
  1.  ;;or the pages on the "EDIT a patient's file" option:
  1.  ;;
  1.  ;; Field                 Option                Page#  Field#
  1.  ;; --------------------  ---------------------   ---    ---
  1.  ;; PATIENT NAME          Patient Registration (NAM)
  1.  ;; EMERGENCY CONTACT     EDIT a patient's file     3     1
  1.  ;; FATHER'S NAME         EDIT a patient's file     3     8
  1.  ;; MOTHER'S MAIDEN NAME  EDIT a patient's file     3    11
  1.  ;; OTHER NAME (ALIASES)  EDIT a patient's file     8     4
  1.  ;; NAME OF INSURED (MCD) EDIT a patient's file     5   "E"
  1.  ;; NAME OF POLICY HOLDER EDIT a patient's file    7a   "E"
  1.  ;; NAME OF INSURED (PVT) EDIT a patient's file    7a   "E"
  1.  ;; NEXT OF KIN           EDIT a patient's file    10     1
  1.  ;;  
  1.  ;; -- Here is the report:
  1.  ;;ASUFAC     HRN                     FIELD    VALUE
  1.  ;;======  ======     =====================    =============================
  1.  ;;###
  1.  ; --------------------------------------------------------
  1. QUE ;EP - From Option
  1.  D HELP^XBHELP("TXT","AGEDNAME")
  1.  Q:'$$DIR^XBDIR("YO","Proceed","N","","Do you want to proceed with the report to check format of names (Y/N)")
  1.  S XBRP="START^AGEDNAME",ZTIO=""
  1.  D ^XBDBQUE,HOME^%ZIS
  1.  I $D(ZTSK) W !!,"QUEUED TO TASK ",ZTSK,!!,"A mail message with the results will be sent to your MailMan 'IN' basket.",!
  1.  Q
  1. START ;EP - From Taskman
  1.  N AG,AGFAC,AGHRN,DFN,AGDONE,AGP3,AGSITE
  1.  K ^TMP("AGEDNAME",$J)
  1.  F %=1:1 D OUT($P($T(TXT+%),";",3)) Q:$P($T(TXT+%+1),";",3)="###"
  1.  F %=1:1 D OUT($P($T(TXT1+%),";",3)) Q:$P($T(TXT1+%+1),";",3)="###"
  1.  S DFN=0,AGP3=$P($G(^AUPNPAT(0)),U,3)
  1.  F  S DFN=$O(^AUPNPAT(DFN)) Q:'DFN  D  I '(DFN#1000),'$D(ZTQUEUED) W !,"On IEN ",DFN," of ",AGP3," in ^AUPNPAT(..."
  1.  . Q:'$D(^DPT(DFN))  Q:$P(^(DFN,0),U,19)  ;merged pt
  1.  . S (AGDONE,AGSITE)=0
  1.  . F  S AGSITE=$O(^AUPNPAT(DFN,41,AGSITE)) Q:'AGSITE  D  Q:AGDONE
  1.  .. I $L($P($G(^AUPNPAT(DFN,41,AGSITE,0)),U,5)) Q:"DM"[$P(^(0),U,5)  ;deleted or merged patient
  1.  .. S AGFAC=$P($G(^AUTTLOC(DUZ(2),0)),U,10),AGHRN="??????"
  1.  .. I $L($P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)) S AGHRN=$P(^(0),U,2)
  1.  .. E  I $L($P($G(^AUPNPAT(DFN,41,AGSITE,0)),U,2)) S AGHRN=$P(^(0),U,2),AGFAC=$P($G(^AUTTLOC(AGSITE,0)),U,10)
  1.  .. D CHK("PATIENT NAME :  ",$P($G(^DPT(DFN,0)),U))
  1.  .. D CHK("EMERGENCY CONTACT :  ",$P($G(^DPT(DFN,.33)),U))
  1.  .. D CHK("FATHER'S NAME :  ",$P($G(^DPT(DFN,.24)),U))
  1.  .. D CHK("MOTHER'S MAIDEN NAME :  ",$P($G(^DPT(DFN,.24)),U,3))
  1.  .. D CHK("NEXT OF KIN :  ",$P($G(^DPT(DFN,.21)),U))
  1.  .. D MCD
  1.  .. S AG=0
  1.  .. F  S AG=$O(^DPT(DFN,.01,AG)) Q:'AG  D CHK("OTHER NAME (ALIASES) :  ",$P($G(^DPT(DFN,.01,AG,0)),U))
  1.  .. S AG=0
  1.  .. F  S AG=$O(^AUPNPRVT(DFN,11,AG)) Q:'AG  D
  1.  ... D CHK("NAME OF INSURED (PVT) :  ",$P($G(^AUPNPRVT(DFN,11,AG,0)),U,4))
  1.  ... D NPH($P($G(^AUPNPRVT(DFN,11,AG,0)),U,8))
  1.  ...Q
  1.  .. S AGDONE=1 ;pt is done, one and only one time
  1.  ..Q
  1.  .Q
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AGEDNAME"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="XUPROGMODE","AGZMENU","AGZMGR","ABMDZ TABLE MAINTENANCE","ABMDZ ELIGIBILITY EDIT","APCCZMGR" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("AGEDNAME",$J)
  1.  D EN^XBVK("AG")
  1.  I $D(ZTQUEUED) S ZTREQ="@" Q
  1.  W !!,"The results are in your MailMan 'IN' basket.",!
  1.  Q
  1. MCD ;
  1.  NEW D,N,S
  1.  S S=0
  1.  F  S S=$O(^AUPNMCD("AB",DFN,S)) Q:'S  S N=0 D
  1.  . F  S N=$O(^AUPNMCD("AB",DFN,S,N)) Q:'N  S D=0 D
  1.  .. F  S D=$O(^AUPNMCD("AB",DFN,S,N,D)) Q:'D  D
  1.  ... D CHK("NAME OF INSURED (MCD) :  ",$P($G(^AUPNMCD(D,0)),U,5))
  1.  ... D NPH($P($G(^AUPNMCD(D,0)),U,9))
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1. NPH(I) ;
  1.  Q:'I
  1.  D CHK("NAME OF POLICY HOLDER :  ",$P($G(^AUPN3PPH(I,0)),U))
  1.  Q
  1. CHK(F,X) ;
  1.  Q:((X="")!(X="SAME"))
  1.  NEW AG
  1.  S AG=X
  1.  D NAME^AUPNPED
  1.  Q:$D(X)
  1.  D RSLT(F_U_AG)
  1.  Q
  1. RSLT(%) S %=$J(AGFAC,6)_$J(AGHRN,8)_$J($P(%,U,1),30)_"'"_$P(%,U,2)_"'"
  1. RSLT1 S ^(0)=$G(^TMP("AGEDNAME",$J,0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,%
  1.  Q
  1. OUT(%) D RSLT1 Q
  1. SINGLE(K) ;Get holders of a single key K.
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q