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

AG6P14.m

Go to the documentation of this file. 
  1. AG6P14 ;IHS/ASDST/GTH - AG 6 PATCH 14 ; 
  1.  ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003
  1.  ;
  1.  ; IHS/ASDST/GTH AG*6*14 09/27/2001
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(1) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(1) Q
  1.  ;
  1.  I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(1) Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,","))
  1.  W !!,$$C^XBFUNC("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".")
  1.  ;
  1.  S X=$$VERSION^XPDUTL("AG")
  1.  W !!,$$C^XBFUNC("Need AG v 6.0.....AG v "_X_" Present")
  1.  I X<6 D SORRY(1) Q
  1.  ;
  1.  S X=$$VERSION^XPDUTL("DI")
  1.  W !,$$C^XBFUNC("Need at least FileMan 21.....FileMan "_X_" Present")
  1.  I X<21 D SORRY(1) Q
  1.  ;
  1.  S X=$$VERSION^XPDUTL("XU")
  1.  W !,$$C^XBFUNC("Need at least Kernel 8.....Kernel "_X_" Present")
  1.  I X<8 D SORRY(1) Q
  1.  ;
  1.  S X=$$VERSION^XPDUTL("AUT")
  1.  W !,$$C^XBFUNC("Need at least AUT 98.1.....AUT "_X_" Present")
  1.  I X<98.1,+X'=1.1 D SORRY(1) Q
  1.  ;
  1.  S X=$$VERSION^XPDUTL("AUPN")
  1.  W !,$$C^XBFUNC("Need at least AUPN 99.1.....AUPN "_X_" Present")
  1.  I X<99.1 D SORRY(1) Q
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AG",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AG")) D  Q
  1.  . W !!,*7,*7,$$C^XBFUNC("You Have More Than One Entry In The"),!,$$C^XBFUNC("PACKAGE File with an ""AG"" prefix.")
  1.  . W !,$$C^XBFUNC("One entry needs to be deleted.")
  1.  . W !,$$C^XBFUNC("FIX IT! Before Proceeding."),!!,*7,*7,*7
  1.  . D SORRY(1)
  1.  . I $$DIR^XBDIR("E")
  1.  .Q
  1.  W !,$$C^XBFUNC("No 'AG' dups in PACKAGE file")
  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.  . D BMES^XPDUTL("Saving 7 AGTX* routines, just in case....")
  1.  . D BEFSAV
  1.  . D BMES^XPDUTL("Saving the configuration of option AGMENU...")
  1.  . D OPTSAV("AGMENU")
  1.  .Q
  1.  ;
  1.  W !!,$$C^XBFUNC("ENVIRONMENT OK.")
  1.  ;
  1.  NEW B
  1.  I $G(XPDA) S B=$O(^XTMP("XPDI",XPDA,"BLD",0))
  1.  I $G(B),$$DIR^XBDIR("Y","Do you want to see the notes","NO","Do you want to see the notes file for this patch","","",1) D
  1.  . S %=0
  1.  . F  S %=$O(^XTMP("XPDI",XPDA,"BLD",B,1,%)) Q:'%   W !,^(%,0) I '(%#20),'$$DIR^XBDIR("E","","","","","",1) Q
  1.  .Q
  1.  KILL B
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(1) Q
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X,XPDQUIT("AG*6*14")=1
  1.  W:'$D(ZTQUEUED) *7,!,$$C^XBFUNC("Sorry...."),$$DIR^XBDIR("E","Press RETURN")
  1.  Q
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  Q
  1.  D BMES^XPDUTL("Beginning pre-install routine (PRE^AG6P14).")
  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^AG6P14).")
  1.  D INDEXAI
  1.  ;
  1.  D BMES^XPDUTL("Saving 7 AGTX* post-P14 routines, just in case....")
  1.  D AFTSAV^AGTXCONF
  1.  ;
  1.  D BMES^XPDUTL("Q'ing Name check report...")
  1.  S ZTRTN="START^AGEDNAME",ZTIO="",ZTDESC=$P($P($T(+1^AGEDNAME),";",2)," ",3,99),ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK) D MES^XPDUTL("Que'd to task "_ZTSK_".") I 1
  1.  E  D BMES^XPDUTL("Que of Name check report *FAILED*.")
  1.  ;
  1.  D BMES^XPDUTL("Attaching ""AG REP NAME CHECK"" option to menu ""REGISTRATION REPORTS"".")
  1.  I $$ADD^XPDMENU("AGREPORTS","AG REP NAME CHECK","STD",25) D BMES^XPDUTL("....successfully atch'd....allocating Security Keys...") D  I 1
  1.  . NEW AG,DA,DIC,DINUM
  1.  . S AG=0,AG("RPT")=$O(^DIC(19.1,"B","AGZREPORTS",0)),AG("STD")=$O(^DIC(19.1,"B","AGZNAMECHECK",0))
  1.  . Q:'AG("RPT")!'AG("STD")
  1.  . S DIC(0)="NMQ",DIC("P")="200.051PA"
  1.  . F  S AG=$O(^XUSEC("AGZREPORTS",AG)) Q:'AG  D
  1.  .. Q:$D(^VA(200,AG,51,AG("STD")))
  1.  .. S DIC="^VA(200,AG,51,",DA(1)=AG,(DINUM,X)=AG("STD")
  1.  .. D FILE^DICN
  1.  ..Q
  1.  .Q
  1.  E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  ;
  1.  D BMES^XPDUTL("Attaching ""AGTXALL"" option to the export menu ""AGTX"".")
  1.  I $$ADD^XPDMENU("AGTX","AGTXALL","ALL",10) D BMES^XPDUTL("....successfully atch'd."),BMES^XPDUTL("NOTE: Security key will *NOT* be allocated.") I 1
  1.  E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  ;
  1.  D BMES^XPDUTL("Attaching ""AG TX CONFIG"" option to the export menu ""AGTX"".")
  1.  I $$ADD^XPDMENU("AGTX","AG TX CONFIG","CON",11) D BMES^XPDUTL("....successfully atch'd."),BMES^XPDUTL("NOTE: Security key will *NOT* be allocated.") I 1
  1.  E  D BMES^XPDUTL("....Attachment *FAILED*.")
  1.  ;
  1.  D BMES^XPDUTL("Restoring ""AGMENU"" option to PRE-install configuration...")
  1.  D OPTRES("AGMENU")
  1.  ;
  1.  D BMES^XPDUTL("Delivering AG*6*14 install message to select users...")
  1.  D SAVE
  1.  NEW DIFROM
  1.  D MAIL^XBMAIL("AGZMENU,XUMGR-XUPROGMODE","MSG^AG6P14MS")
  1.  S X="AG6P14MS"
  1.  X ^%ZOSF("DEL")
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine is complete.")
  1.  Q
  1.  ;
  1. SAVE ; Save first few lines of install message into tmp global.
  1.  KILL ^TMP("AG6P14MS",$J)
  1.  S ^TMP("AG6P14MS",$J,1,0)="AG6P14MS ;IHS/ASDST/GTH - AG6P14 INSTALL MESSAGE ;"
  1.  S ^TMP("AG6P14MS",$J,2,0)=$T(+2)
  1.  S ^TMP("AG6P14MS",$J,3,0)="MSG ;;"
  1.  S ^TMP("AG6P14MS",$J,4,0)=" ;;AG V "_$P($T(+2),";",3)_" "_$P($T(+2),";",4)_", Patch "_$P($P($T(+2),";",5),"**",2)
  1.  S ^TMP("AG6P14MS",$J,5,0)=" ;; --- AG v 6, Patch 14, has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AG6P14MS",$J,(%+5),0)=" ;;"_^(%,0)
  1.  NEW XCM,DIE,XCN
  1.  S X="AG6P14MS",DIE="^TMP(""AG6P14MS"",$J,",XCN=0
  1.  X ^%ZOSF("SAVE")
  1.  KILL ^TMP("AG6P14MS",$J)
  1.  Q
  1.  ;
  1. INDEXAI ; REINDEX AI XREF PREVIOUS COMMUNITY 
  1.  ;
  1.  ; Thanks to Toni Jarland for the original routine.  Aug 17 2001.
  1.  ;
  1.  ;This runs the AI X-Ref Re-Index of the Previous Communty Multiple
  1.  ;$Order through each AUPNPAT Global Entry & Re-Index AI X-Ref
  1.  ;The AI X-Ref calls Routine AUPNPCTR which $O thru the Previous
  1.  ;Community Multiple & resets the Last Previous Community Entry
  1.  ;to fields #1117 Current Community Mulitple & #1118 Current Community
  1.  ;Text Value.  This will clean up missing Community Pointers used
  1.  ;in the Patient Registration Re-export
  1.  ;
  1.  I $P($T(+2^AUPNPCTR),";",5)'="**6**" D  Q
  1.  . D BMES^XPDUTL("AUPN PATCH 6 IS NOT INSTALLED.")
  1.  . D BMES^XPDUTL("THE AI X-REF RE-FIRE WILL BE IN VAIN.")
  1.  . D BMES^XPDUTL("INSTALL AUPN 99.1 PATCH 6 AND RUN INDEXAI^AG6P14.")
  1.  .Q
  1.  NEW AGB,AGE
  1.  S AGB=$$NOW^XLFDT
  1.  D BMES^XPDUTL("Begin Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGB))
  1.  W:'$D(ZTQUEUED) !,"Estimated % complete:",!
  1.  NEW AGP3,DA,DIK
  1.  S DA(1)=0,DIK(1)=".03^AI",AGP3=$P(^AUPNPAT(0),U,3)
  1.  F  S DA(1)=$O(^AUPNPAT(DA(1))) Q:'DA(1)  D
  1.  . S DIK="^AUPNPAT("_DA(1)_",51,"
  1.  . D ENALL^DIK
  1.  . I '(DA(1)#100),'$D(ZTQUEUED) W " | ",$J(DA(1)/AGP3*100,0,0),"%"
  1.  .Q
  1.  ;
  1.  S AGE=$$NOW^XLFDT
  1.  D BMES^XPDUTL("End of Re-Indexing AI Cross Reference of PATIENT File, "_$$FMTE^XLFDT(AGE))
  1.  D BMES^XPDUTL($$FMDIFF^XLFDT(AGE,AGB,2)_" seconds")
  1.  Q
  1.  ;
  1. BEFSAV ;this is the same s/r as in AGTXCONF.
  1.  NEW AG,AGM,XCN,XCNP,DIE,DIF
  1.  F AG=1:1:7 D
  1.  . D KT
  1.  . S X=$P($T(BEF+AG),";",3),(XCN,XCNP)=0,(DIE,DIF)="^TMP(""AGTXCONF"",$J,"
  1.  . S AGM="Loading '"_X_"'..."
  1.  . X ^%ZOSF("LOAD")
  1.  . S X=$P($T(BEF+AG),";",4)
  1.  . X ^%ZOSF("TEST")
  1.  . I  D MES^XPDUTL(AGM_"NOT SAVED AS '"_X_"'.  '"_X_"' ALREADY EXISTS.") Q
  1.  . X ^%ZOSF("SAVE")
  1.  . D MES^XPDUTL(AGM_"Saved as '"_X_"'.")
  1.  .Q
  1.  D KT
  1.  Q
  1.  ;
  1. KT KILL ^TMP("AGTXCONF",$J)
  1.  Q
  1.  ;
  1. BEF ; These are the "before p14" routines.
  1.  ;;AGTX1;AGTXX1
  1.  ;;AGTX2;AGTXX2
  1.  ;;AGTX3;AGTXX3
  1.  ;;AGTX4;AGTXX4
  1.  ;;AGTX5;AGTXX5
  1.  ;;AGTXST;AGTXX6
  1.  ;;AGTXTAPE;AGTXX7
  1.  ;
  1. OPTSAV(AGM) ;
  1.  I $D(^XTMP("AG6P14",6.14,"OPTSAV",AGM)) D BMES^XPDUTL("NOT SAVED.  Option '"_AGM_"' has previously been saved.") Q
  1.  I '$D(^XTMP("AG6P14")) S ^XTMP("AG6P14",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"AG6P14 - SAVE OPTION CONFIGURATIONS."
  1.  NEW I,A
  1.  S I=$O(^DIC(19,"B",AGM,0))
  1.  I 'I D BMES^XPDUTL("NOT SAVED.  Option '"_AGM_"' not found in OPTION file.") Q
  1.  S A=0
  1.  F  S A=$O(^DIC(19,I,10,A)) Q:'A  S ^XTMP("AG6P14",6.14,"OPTSAV",AGM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
  1.  Q
  1.  ;
  1. OPTRES(AGM) ;
  1.  NEW AG,AGI
  1.  I '$D(^XTMP("AG6P14",6.14,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED.  Option '"_AGM_"' was not previously saved.") Q
  1.  S AG=0
  1.  F  S AG=$O(^XTMP("AG6P14",6.14,"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.  Q
  1.  ;