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

AUM4101.m

Go to the documentation of this file. 
  1. AUM4101 ;TASSC/MFD - SCB UPDATE 10/31/2003 [ 11/25/2003  12:43 PM ]
  1.  ;;04.1;TABLE MAINTENANCE;**1**;OCT 31,2003
  1.  ;
  1. ENV ;----- ENVIRONMENT CHECK
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  K XPDQUIT
  1.  ;
  1.  D DUZ(.DUZ,.XPDQUIT)
  1.  Q:$D(XPDQUIT)
  1.  ;
  1.  D HELLO(DUZ)
  1.  ;
  1.  ; Check for required versons and patches
  1.  ;
  1.  I $$VCHK("XU","8.0",2,"<")
  1.  I $$VCHK("DI","21.0",2,"<")
  1.  I $$VCHK("AUM","4.1",2,"'=")
  1.  I $$VCHK("AUT","98.1",2,"'=")
  1.  I $$PCHK("AUT","98.1",13,2,"<")
  1.  Q:$D(XPDQUIT)
  1.  ;
  1.  D CKPKG(.XPDQUIT)    ;Check for dupes in package file
  1.  ;
  1.  D OK(.XPDQUIT)
  1.  Q:$D(XPDQUIT)
  1.  ;
  1.  D HELP^XBHELP("INTROE","AUM4101")
  1.  ;
  1.  D XPZ
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(3,.XPDQUIT)
  1.  ;
  1.  Q
  1.  ;
  1. DUZ(DUZ,XPDQUIT)   ;
  1.  ;----- CHECK FOR VALID DUZ
  1.  ;
  1.  I '$G(DUZ) D
  1.  . W !,"DUZ UNDEFINED OR 0"
  1.  . D SORRY(2,.XPDQUIT)
  1.  I '$L($G(DUZ(0))) D
  1.  . W !,"DUZ(0) UNDEFINED OR NULL"
  1.  . D SORRY(2,.XPDQUIT)
  1.  Q
  1. HELLO(DUZ)         ;
  1.  ;----- DISPLAY GREETING
  1.  ;
  1.  N X
  1.  S X=$P($G(^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.  Q
  1. CKPKG(XPDQUIT)     ;
  1.  ;----- CHECK PACKAGE FILE FOR DUPLICATE ENTRY
  1.  ;
  1.  N D,DIC,X,Y
  1.  S X="AUM"
  1.  S DIC="^DIC(9.4,"
  1.  S DIC(0)=""
  1.  S D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AUM")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You have more than one entry in the",IOM)
  1.  . W !,$$CJ^XLFSTR("PACKAGE file with an ""AUM"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
  1.  . S XPDQUIT=2
  1.  Q
  1. XPZ ;----- SET XPDDIQ ARRAY TO KEEP KIDS FROM ASKING DISABLE AND CPU
  1.  ;      MOVE QUESTIONS
  1.  I $G(XPDENV)=1 D
  1.  . S (XPDDIQ("XPZ1"))=0
  1.  . S (XPDDIQ("XPZ2"))=0
  1.  . D HELP^XBHELP("INTROI","AUM4101")
  1.  Q
  1. OK(XPDQUIT)        ;
  1.  ;----- ISSUE OK MESSAGE
  1.  ;
  1.  I $D(XPDQUIT) D  Q
  1.  . W !,$$CJ^XLFSTR("FIX IT! Before Proceeding",IOM),!!,*7,*7,*7
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK",IOM)
  1.  Q
  1. SORRY(X,XPDQUIT)   ;
  1.  K DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. VCHK(AUMPRE,AUMVER,AUMQUIT,AUMCOMP)    ;
  1.  ;----- CHECK VERSIONS NEEDED
  1.  ;  
  1.  N AUMV
  1.  S AUMV=$$VERSION^XPDUTL(AUMPRE)
  1.  W !,$$CJ^XLFSTR("Need "_$S(AUMCOMP="<":"at least ",1:"")_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)
  1.  I @(+AUMV_AUMCOMP_AUMVER) D SORRY(AUMQUIT) Q 0
  1.  Q 1
  1.  ;
  1. PCHK(AUMPRE,AUMVER,AUMPAT,AUMQUIT,AUMCOMP)     ;    
  1.  ;----- CHECK PATCHES NEEDED
  1.  N AUMV,AUMX
  1.  S AUMV=AUMPRE_"*"_AUMVER_"*"_AUMPAT
  1.  S AUMX=$$PATCH^XPDUTL(AUMV)
  1.  W !,$$CJ^XLFSTR("Need "_$S(AUMCOMP="<":"at least ",1:"")_AUMV_"....."_$S(AUMX:" Present",1:" NOT Present"),IOM)
  1.  I 'AUMX D SORRY(AUMQUIT) Q 0
  1.  Q 1
  1.  ;
  1. POST ;EP -- POST INSTALL FROM KIDS
  1.  ;
  1.  I ^DD(9999999.03,.01,1,1,1)["1,40)," D BINDEX
  1.  K ^TMP("AUM4101",$J)
  1.  D AUDS
  1.  D START^AUM41011
  1.  D AUDR
  1.  D MAIL
  1.  ;D QUE   ;this deletes the routines from this update
  1.  Q
  1. MAIL ;----- SEND EMAIL
  1.  ;
  1.  K ^TMP("AUM4101",$J)
  1.  N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  D MES^XPDUTL("BEGIN Delivering MailMan message to select users...")
  1.  D RSLT^AUM41011(" --- AUM v 4.1, Patch 1, has been installed ---")
  1.  F %=1:1 D RSLT^AUM41011($P($T(GREET+%),";",3)) Q:$P($T(GREET+%+1),";",3)="###"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   D RSLT^AUM41011(^(%,0))
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""AUM4101"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="XUMGR","XUPROG","XUPROGMODE","AGZBILL","ABMDZ TABLE MAINTENANCE","APCCZMGR" D SINGLE(%)
  1.  D ^XMD
  1.  K ^TMP("AUM4101",$J)
  1.  D MES^XPDUTL("END Delivering MailMan message to select users...")
  1.  Q
  1.  ;
  1. QUE ;----- QUEUE ROUTINE DELETION     
  1.  ;
  1.  N X,Y,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTREQ,ZTRTN,ZTSK
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q:'$L($T(+1^AUMDELR))
  1.  S ZTRTN="DEL^AUMDELR(""AUM4101"")"
  1.  S ZTDESC="Delete routines in the 'AUM4101' namespace"
  1.  S ZTDTH=$$HADD^XLFDT($H,0,0,30,0)
  1.  S ZTIO=""
  1.  S ZTPRI=1
  1.  D ^%ZTLOAD
  1.  I '$D(ZTSK) D  Q
  1.  . D BMES^XPDUTL("Q to TaskMan to delete routines in background failed (?)")
  1.  D BMES^XPDUTL("NOTE: The routines in this update will be deleted in the background")
  1.  D BMES^XPDUTL("30 minutes from now by Task #"_ZTSK)
  1.  Q
  1. SINGLE(K) ;
  1.  ;----- GET HOLDERS OF A SINGLE KEY K, PUT IN XMY ARRAY
  1.  ;
  1.  N 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. AUDS ;----- SAVE CURRENT SETTINGS AND SET DATA AUDITING 'ON'
  1.  ;
  1.  ; NOTE:
  1.  ; Data auditing at the file level is indicated by a lower case "a"
  1.  ; in the 2nd piece of the 0th node of the global.
  1.  ; Data auditing at the field level is indicated by a lower case "a"
  1.  ; in the 2nd piece of the 0th node of the field definition in ^DD(.
  1.  ;
  1.  S ^XTMP("AUM4101",0)=$$FMADD^XLFDT(DT,56)_"^"_DT_"^"_"**ADD DATE** STANDARD TABLE UPDATES"
  1.  N G,P
  1.  F %=1:1 S G=$P($T(AUD+%),";",3) Q:G="END"  D
  1.  . S P=$P(@(G_"0)"),"^",2)
  1.  . I '$D(^XTMP("AUM4101",G)) S ^XTMP("AUM4101",G)=P
  1.  . S:'(P["a") $P(@(G_"0)"),"^",2)=P_"a"
  1.  . D AUDF(+P)
  1.  Q
  1. AUDF(F) ;----- PROCESS ALL FIELDS FOR FILE 4, INCLUDING SUB-FILES
  1.  ;
  1.  N D,P
  1.  S D=0
  1.  F  S D=$O(^DD(F,D)) Q:'D  D
  1.  . I $P(^DD(F,D,0),U,2) D AUDF(+$P(^(0),U,2)) Q
  1.  . S P=$P(^DD(F,D,0),U,2),G="^DD("_F_","_D_","
  1.  . I '$D(^XTMP("AUM4101",G)) S ^XTMP("AUM4101",G)=P
  1.  . I '$D(^XTMP("AUM4101",G,"AUDIT")) S ^XTMP("AUM4101",G,"AUDIT")=$G(@(G_"""AUDIT"")"))
  1.  . S:'(P["a") $P(@(G_"0)"),"^",2)=P_"a"
  1.  . S ^DD(F,D,"AUDIT")="y"
  1.  Q
  1. AUDR ;----- RESTORE THE FILE DATA AUDIT VALUES TO THEIR ORIGINAL VALUES
  1.  ;
  1.  N G,P
  1.  S G=0
  1.  F  S G=$O(^XTMP("AUM4101",G)) Q:'$L(G)  D
  1.  . S $P(@(G_"0)"),"^",2)=^XTMP("AUM4101",G)
  1.  . Q:'(G["^DD(")
  1.  . S (@(G_"""AUDIT"")"))=^XTMP("AUM4101",G,"AUDIT")
  1.  . K:@(G_"""AUDIT"")")="" @(G_"""AUDIT"")")
  1.  Q
  1. AUD ;----- THESE ARE FILES TO BE DATA AUDITED FOR THIS PATCH ONLY
  1.  ;;^AUTTEXAM(
  1.  ;;^AUTTTRI(
  1.  ;;^AUTTEDPF(
  1.  ;;^AUTTAREA(
  1.  ;;^AUTTCOM(
  1.  ;;^AUTTCTY(
  1.  ;;^AUTTHF(
  1.  ;;^AUTTLOC(
  1.  ;;^AUTTMSR(
  1.  ;;^AUTTSU(
  1.  ;;^DIC(7,
  1.  ;;^DIC(40.7,
  1.  ;;END
  1.  Q
  1. AUDPRT ;----- PRINT FROM AUDIT FILE
  1.  ;
  1.  N BY,DIC,FLDS,X,Y
  1.  Q:$D(ZTQUEUED)
  1.  W !,"*** Print from the AUDIT file."
  1.  S DIC=1
  1.  S DIC("A")="Select the file from which you want to print the data AUDIT: "
  1.  S DIC(0)="A"
  1.  D ^DIC
  1.  Q:+Y<1
  1.  S DIC="^DIA("_+Y_","
  1.  S FLDS="[CAPTIONED]"
  1.  S BY=.02
  1.  D EN1^DIP
  1.  Q
  1. INTROE ;----- INTRO TEXT DURING KIDS ENVIRONMENT CHECK
  1.  ;;This distribution:
  1.  ;;(1) Implements SCB mods for the past several months
  1.  ;;(2) New entry into EXAM file- INT PARTNER VIOLENCE SCREEN
  1.  ;;(3) New entries into HEALTH FACTORS
  1.  ;;(4) New PROVIDER CLASS added - PHARMACY TECHNICIAN
  1.  ;;(5) Several new entries to the CLINIC STOP file
  1.  ;;###
  1.  ;
  1. INTROI ;----- INTRO TEXT DURING KIDS INSTALL
  1.  ;;A standard message will be produced by this update.
  1.  ;;  
  1.  ;;If you run interactively, results will be displayed on your screen,
  1.  ;;as well as in the mail message and the entry in the INSTALL file.
  1.  ;;If you queue to TaskMan, please read the mail message for results of
  1.  ;;this update, and remember not to Q to the HOME device.
  1.  ;;###
  1.  ;
  1. GREET ;;EP - TO ADD TO MAIL MESSAGE
  1.  ;;  
  1.  ;;Greetings.
  1.  ;;  
  1.  ;;Standard tables on your RPMS system have been updated.
  1.  ;;  
  1.  ;;You are receiving this message because of the particular RPMS
  1.  ;;security keys that you hold.  This is for your information, only.
  1.  ;;You need do nothing in response to this message.
  1.  ;;  
  1.  ;;Requests for modifications or additions to RPMS standard tables,
  1.  ;;whether they are or are not contained in the IHS Standard Code
  1.  ;;Book (SCB), can be submitted to your Area Information System
  1.  ;;Coordinator (ISC).
  1.  ;;  
  1.  ;;Sections of the IHS Standard Code Book (SCB) can be viewed, printed,
  1.  ;;and extracted from the NPIRS Intranet website at url:
  1.  ;;  http://dpsntweb1.hqw.DOMAIN.NAME/ciweb/main.html
  1.  ;;  
  1.  ;;Questions about this patch, which is a product of the RPMS DBA
  1.  ;;can be directed to the Help Desk,
  1.  ;;".  Please
  1.  ;;refer to patch "AUM*4.1*1".
  1.  ;;  
  1.  ;;###;NOTE: This line indicates the end of text in this message.
  1.  ;
  1. BINDEX ;
  1.  K ^AUTTTRI("B")
  1.  S ^DD(9999999.03,.01,1,1,1)="S ^AUTTTRI(""B"",$E(X,1,30),DA)="""""
  1.  S ^DD(9999999.03,.01,1,1,2)="K ^AUTTTRI(""B"",$E(X,1,30),DA)"
  1.  S DIK="^AUTTTRI(",DIK(1)=".01^B" D ENALL^DIK
  1.  Q