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

AG7P2A.m

Go to the documentation of this file. 
  1. AG7P2A ;IHS/SD/EFG - Patient Registration 7.0 Patch 2 CONT. ;   [ 06/17/2003  10:49 AM ]
  1.  ;;7.0;IHS PATIENT REGISTRATION;**1,2,3**;MAR 28, 2003
  1.  ;
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  ;
  1.  D BMES^XPDUTL("Beginning post-install routine (POST^AG7P2A)."),TS
  1.  ;
  1.  D ^AGSETPRT
  1.  ;
  1.  D AGFAC
  1.  ;
  1.  D PRVT
  1.  ;
  1.  D ^AGMCDCNT
  1.  ;
  1.  D MCD
  1.  ;
  1.  I $$INSTALLD^AG7P2("AG*7.0*2") D
  1.  . D TS,BMES^XPDUTL("Delivering AG*7.0*2 install message to select users ...")
  1.  . D MAIL
  1.  . D BMES^XPDUTL("Post-install routine is complete."),TS
  1.  ;
  1.  Q:$$INSTALLD^AG7P2("AG*7.0*2")
  1.  ;
  1.  D TS,OPTRES("AGMENU")
  1.  ;
  1.  D TS,BMES^XPDUTL("Delivering AG*7.0*2 install message to select users...")
  1.  ;
  1.  D MAIL
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine is complete."),TS
  1.  Q
  1.  ;
  1. MAIL ; Send install mail message.
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("AG7P2MS",$J)
  1.  S ^TMP("AG7P2MS",$J,1)=" --- AG v 7.0, Patch 2 has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AG7P2MS",$J,(%+1))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG7P2MS"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("AG7P2MS",$J)
  1.  Q
  1.  ;
  1. SINGLE(K) ;EP - 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. OPTRES(AGM) ;
  1.  D BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
  1.  NEW AG,AGI
  1.  I '$D(^XTMP("AG7P2",7.2,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED.  Option '"_AGM_"' was not previously saved.") Q
  1.  S AG=0
  1.  F  S AG=$O(^XTMP("AG7P2",7.2,"OPTSAV",AGM,AG)) Q:'AG  S AGI=^(AG) I '$$ADD^XPDMENU(AGM,$P(AGI,U,1),$P(AGI,U,2),$P(AGI,U,3)) D BMES^XPDUTL("....FAILED to re-atch "_$P(AGI,U,1)_" to "_AGM_".")
  1.  D BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")
  1.  I $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20) D BMES^XPDUTL("....successfully atch'd.") I 1
  1.  E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  ;
  1.  Q
  1.  ;
  1. TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
  1.  ;
  1. AGFAC ; FEED NEW REGISTRATION PARAMETERS IF BLANK
  1.  S AGFAC=0
  1.  F  S AGFAC=$O(^AGFAC("B",AGFAC)) Q:'AGFAC  D
  1.  . S AGFACPTR=0
  1.  . F  S AGFACPTR=$O(^AGFAC("B",AGFAC,AGFACPTR)) Q:'AGFACPTR  D
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,22)="" S $P(^AGFAC(AGFACPTR,0),U,22)=0
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,23)="" S $P(^AGFAC(AGFACPTR,0),U,23)="N"
  1.  .. I $P($G(^AGFAC(AGFACPTR,0)),U,24)="" S $P(^AGFAC(AGFACPTR,0),U,24)="N"
  1.  K AGFAC,AGFACPTR
  1.  Q
  1. PRVT ; FIND ANY PRIVATE ELIG MISSING INSURER POINTER
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNPRVT(RECNO)) Q:'RECNO  D
  1.  . S D1=0
  1.  . F  S D1=$O(^AUPNPRVT(RECNO,11,D1)) Q:'D1  D
  1.  .. I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U,1)=""  D
  1.  ... K ^AUPNPRVT(RECNO,11,D1,0)
  1.  Q
  1. MCD ; FIND MCD MISSING .01 FIELD
  1.  S RECNO=0
  1.  F  S RECNO=$O(^AUPNMCD(RECNO)) Q:'RECNO  D
  1.  . S MCDREC=$G(^AUPNMCD(RECNO,0))
  1.  . I $P(MCDREC,U,1)="" K ^AUPNMCD(RECNO,0)
  1.  Q