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

AUPN99P7.m

Go to the documentation of this file. 
  1. AUPN99P7 ;IHS/CMI/LAB,GTH,EFG,SDR - AUPN 99.1 PATCH 7 ; [ 05/09/2003  7:58 AM ]
  1.  ;;99.1;IHS DICTIONARIES (PATIENT);**7,9,10**;JUN 13, 2003;Build 9
  1.  ;
  1.  ; IHS/ASDST/GTH AUPN*99.1*7 02/15/2002
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM)
  1.  ;
  1.  NEW AUPNQUIT
  1.  S AUPNQUIT=0
  1.  I '$$VCHK("AUPN","99.1",2) S AUPNQUIT=2
  1.  I '$$VCHK("DI","21.0",2) S AUPNQUIT=2
  1.  I '$$VCHK("XU","8.0",2) S AUPNQUIT=2
  1.  S X=$$VERSION^XPDUTL("AUT")
  1.  W !,$$CJ^XLFSTR("Need at least AUT 98.1.....AUT "_X_" Present",IOM)
  1.  I X<98.1,+X'=1.1 S AUPNQUIT=2
  1.  I '$$INSTALLD("AUT*98.1*7") S AUPNQUIT=2
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AUPN",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AUPN")) D  Q
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUPN"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
  1.  . W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
  1.  . D SORRY(2)
  1.  . I $$DIR^XBDIR("E")
  1.  .Q
  1.  W !,$$CJ^XLFSTR("No 'AUPN' dups in PACKAGE file",IOM)
  1.  ;
  1.  I AUPNQUIT D SORRY(AUPNQUIT) Q
  1.  ;
  1.  I $G(XPDENV)=1 D
  1.  . ; The following line prevents the "Disable Options..." and "Move
  1.  . ; Routines..." questions from being asked during the install.
  1.  . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  .Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
  1.  Q
  1.  ;
  1. VCHK(AUPNPRE,AUPNVER,AUPNQUIT) ; Check versions needed.
  1.  ;  
  1.  NEW AUPNV
  1.  S AUPNV=$$VERSION^XPDUTL(AUPNPRE)
  1.  W !,$$CJ^XLFSTR("Need at least "_AUPNPRE_" v "_AUPNVER_"....."_AUPNPRE_" v "_AUPNV_" Present",IOM)
  1.  I AUPNV<AUPNVER W *7,!,$$CJ^XLFSTR("Sorry....",IOM) Q 0
  1.  Q 1
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  D BMES^XPDUTL("Beginning Pre-install routine (PRE^AUPN99P7).")
  1.  I '$$INSTALLD("AUPN*99.1*6") D  I 1
  1.  . D BMES^XPDUTL("AUPN*99.1*6 NOT installed.  Deleting dd fields .")
  1.  . NEW DIK
  1.  . S DIK="^DD(9000010.24,",DA=.01,DA(1)=9000010.24 D ^DIK
  1.  . S DIK="^DD(9000010.24,",DA=.04,DA(1)=9000010.24 D ^DIK
  1.  . S DIK="^DD(9000010.34,",DA=.01,DA(1)=9000010.34 D ^DIK
  1.  .Q
  1.  E  D BMES^XPDUTL("AUPN*99.1*6 is installed.  No dd fields deleted.")
  1.  ;
  1.  D BMES^XPDUTL("Pre-install routine is complete.")
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  D BMES^XPDUTL("Beginning post-install routine (POST^AUPN99P7).")
  1.  ;
  1.  D QUERPT
  1.  ;
  1.  I '$$INSTALLD("AUPN*99.1*5") D  I 1
  1.  . D BMES^XPDUTL("AUPN*99.1*5 not installed."),MES^XPDUTL("  Indexing AE x-ref on Medicaid Eligible...")
  1.  . D POST^AUPN99P5
  1.  . D MES^XPDUTL("X-ref complete.")
  1.  .Q
  1.  E  D BMES^XPDUTL("AUPN*99.1*5 is installed.  No action necessary.")
  1.  ;
  1.  D MAIL
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine is complete.")
  1.  Q
  1.  ;
  1. MAIL ; Send install mail message.
  1.  D BMES^XPDUTL("Delivering AUPN*99.1*7 install message to select users...")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("AUPN99P7MS",$J)
  1.  S ^TMP("AUPN99P7MS",$J,1)=" --- AUPN v 99.1, Patch 7, has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AUPN99P7MS",$J,(%+1))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUPN99P7MS"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="AGZMENU","APCDZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("AUPN99P7MS",$J)
  1.  Q
  1.  ;
  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
  1.  ;
  1. INSTALLD(AUPNSTAL) ;EP - Determine if patch AUPNSTAL was installed, where
  1.  ; AUPNSTAL is the name of the INSTALL.  E.g "AG*6.0*10".
  1.  ;
  1.  NEW AUPNY,DIC,X,Y
  1.  S X=$P(AUPNSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(AUPNSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(AUPNSTAL,"*",3)
  1.  D ^DIC
  1.  S AUPNY=Y
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q $S(AUPNY<1:0,1:1)
  1.  ;
  1. QUERPT ;
  1.  D BMES^XPDUTL("Q'ing one-time report on begin/end dates in Insurance Eligible files...")
  1.  ;
  1.  S ZTRTN="ELIGDATS^AUPN99P7",ZTDESC="Insurance Eligibility Dates.",ZTDTH=$H,ZTIO="",ZTSAVE("DUZ")=""
  1.  D ^%ZTLOAD
  1.  I '$D(ZTSK) D BMES^XPDUTL("ERROR**:  Q to TaskMan failed (?).") Q
  1.  D BMES^XPDUTL("Q'd to Task '"_ZTSK_"'.")
  1.  Q
  1.  ;
  1. ELIGDATS ;EP - From TaskMan or Programmer mode.
  1.  ; One-time report on Insurance Eligibility records whose Ending date
  1.  ; preceeds the begin date.
  1.  ;
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("AUPN991P7",$J)
  1.  D DATES
  1.  S XMSUB="Insurance Eligibility Dates.",XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""AUPN991P7"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="XUMGR","XUPROGMODE","AGZMENU","ABMDZ ELIGIBILITY EDIT" D SINGLE(%)
  1.  NEW DIFROM
  1.  D ^XMD
  1.  KILL ^TMP("AUPN991P7",$J)
  1.  I $D(ZTQUEUED) S ZTREQ="@" Q
  1.  W !,"The results are in your MailMan 'IN' basket."
  1.  Q
  1.  ;
  1. DATES ;
  1.  ;;This is a one time report, released in patch AUPN*99.1*7.
  1.  ;;  
  1.  ;;However, if you need to rerun the report, D QUERPT^AUPN99P7,
  1.  ;;is the command from programmer mode.
  1.  ;;  
  1.  ;;You are receiving this message b/c of the particular security
  1.  ;;keys that you hold.  If you are not an appropriate person at
  1.  ;;your facility to correct any coverages that are listed, below,
  1.  ;;please ensure the appropriate person receives this report.
  1.  ;;  
  1.  ;;This report lists Insurance elgibility coverages whose coverage
  1.  ;;dates include an ending date that -PRECEEDS- the begin date.
  1.  ;;Coverages with dates in that condition will result in the
  1.  ;;associated beginning date not being found by any Third Party
  1.  ;;Billing application.
  1.  ;;  
  1.  ;;Insurance coverages in this condition were found during routine
  1.  ;;analysis of the 9.5 million insurance eligibility records received
  1.  ;;during the NPIRS reload of 2001.  That analysis indicated about
  1.  ;;12,000 (1/10th of 1 percent) of the records had an ending date
  1.  ;;that preceeded the begin date.
  1.  ;;  
  1.  ;;Patch AUPN*99.1*7 will prevent this condition from being entered
  1.  ;;for MEDICARE, MEDICAID, and RAILROAD insurance elgibiltiy dates
  1.  ;;by placing a check on the ending date during data entry.  However,
  1.  ;;PRIVATE INSURANCE is more complicated in its computation, and an
  1.  ;;associated patch will be released thru Patient Registration (AG).
  1.  ;;  
  1.  ;;end
  1.  ;
  1.  F %=1:1 S X=$P($T(DATES+%),";",3) Q:X="end"  D RSLT(X)
  1.  D HDR,MCR,HDR,MCD,HDR,RRE,HDR,PVT
  1.  Q
  1.  ;
  1. HDR ;
  1.  D RSLT("-------------------------------------------------------------")
  1.  D RSLT(""),RSLT("")
  1.  D RSLT("TYPE        BEGIN DATE    END DATE      TYPE    ASUFAC/HRN")
  1.  D RSLT("-------------------------------------------------------------")
  1.  Q
  1.  ;
  1. MCR ;
  1.  NEW A,D,I,P
  1.  F P=0:0 S P=$O(^AUPNMCR(P)) Q:'P  D
  1.  . F I=0:0 S I=$O(^AUPNMCR(P,11,I)) Q:'I  D
  1.  .. Q:'$P(^AUPNMCR(P,11,I,0),U,2)  S D=^(0)
  1.  .. Q:'($P(D,U,2)<$P(D,U,1))
  1.  .. S A=$$ASU(P),D=$$FMTE(D)
  1.  .. D RSLT("MEDICARE    "_$P(D,U,1)_"  "_$P(D,U,2)_"  "_$$LJ^XLFSTR($P(D,U,3),8)_$P(A,U))
  1.  .. F %=2:1 Q:'$L($P(A,U,%))  D RSLT($J("",48)_$P(A,U,%))
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. MCD ;
  1.  NEW A,I,J,Y,P
  1.  F P=0:0 S P=$O(^AUPNMCD(P)) Q:'P  D
  1.  . F I=0:0 S I=$O(^AUPNMCD(P,11,I)) Q:'I  D
  1.  .. Q:'$P(^AUPNMCD(P,11,I,0),U,2)  S D=^(0)
  1.  .. Q:'($P(D,U,2)<$P(D,U,1))
  1.  .. S A=$$ASU($P(^AUPNMCD(P,0),U)),D=$$FMTE(D)
  1.  .. D RSLT("MEDICAID    "_$P(D,U,1)_"  "_$P(D,U,2)_"  "_$$LJ^XLFSTR($P(D,U,3),8)_$P(A,U))
  1.  .. F %=2:1 Q:'$L($P(A,U,%))  D RSLT($J("",48)_$P(A,U,%))
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. RRE ;
  1.  NEW A,I,P
  1.  F P=0:0 S P=$O(^AUPNRRE(P)) Q:'P  D
  1.  . F I=0:0 S I=$O(^AUPNRRE(P,11,I)) Q:'I  D
  1.  .. Q:'$P(^AUPNRRE(P,11,I,0),U,2)  S D=^(0)
  1.  .. Q:'($P(D,U,2)<$P(D,U,1))
  1.  .. S A=$$ASU(P),D=$$FMTE(D)
  1.  .. D RSLT("RAILROAD    "_$P(D,U,1)_"  "_$P(D,U,2)_"  "_$$LJ^XLFSTR($P(D,U,3),8)_$P(A,U))
  1.  .. F %=2:1 Q:'$L($P(A,U,%))  D RSLT($J("",48)_$P(A,U,%))
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. PVT ;
  1.  NEW A,I,J,Y,P
  1.  F P=0:0 S P=$O(^AUPNPRVT(P)) Q:'P  D
  1.  . F I=0:0 S I=$O(^AUPNPRVT(P,11,I)) Q:'I  D
  1.  .. Q:'$P(^AUPNPRVT(P,11,I,0),U,7)  S D=^(0)
  1.  .. Q:'($P(D,U,7)<$P(D,U,6))
  1.  .. S A=$$ASU($P(^AUPNPRVT(P,0),U)),D=$P(D,U,6)_U_$P(D,U,7)_U_$P(D,U,3),D=$$FMTE(D)
  1.  .. D RSLT("PRIVATE     "_$P(D,U,1)_"  "_$P(D,U,2)_"          "_$P(A,U))
  1.  .. F %=2:1 Q:'$L($P(A,U,%))  D RSLT($J("",48)_$P(A,U,%))
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. ASU(P) ;
  1.  NEW I,X
  1.  S X=""
  1.  F I=0:0 S I=$O(^AUPNPAT(P,41,I)) Q:'I  S X=X_$P(^AUTTLOC(I,0),U,10)_"/"_$J($P(^AUPNPAT(P,41,I,0),U,2),6)_U
  1.  Q X
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("AUPN991P7",$J,0))+1,^(^(0))=%
  1.  Q
  1.  ;
  1. FMTE(D) ;
  1.  NEW A,I,J,Y,P,X
  1.  Q $$FMTE^XLFDT($P(D,U))_U_$$FMTE^XLFDT($P(D,U,2))_U_$P(D,U,3)
  1.  ;