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

AUPN9918.m

Go to the documentation of this file. 
  1. AUPN9918 ;IHS/CMI/LAB,GTH,EFG,SDR - AUPN 99.1 PATCH 18 ; [ 09/06/2007  12:37 PM ]
  1.  ;;99.1;IHS DICTIONARIES (PATIENT);**18**;JUL 16, 2003;Build 9
  1.  ;
  1.  ;
  1.  I '$G(IOM) D HOME^%ZIS
  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 IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  ;
  1.  I $$VCHK("AUPN","99.1",2)
  1.  ;
  1.  I '$$INSTALLD("AUT*98.1*16") D SORRY(2)
  1.  I '$$INSTALLD("AUPN*99.1*17") D SORRY(2)
  1.  I '$$INSTALLD("AICD*3.51*7") D SORRY(2)
  1.  I '$D(^DIC(9.4,"C","LEX")) D SORRY(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(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . D SORRY(2)
  1.  .Q
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR(IORVON_"FIX IT! Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPO1"),XPDDIQ("XPI1"))=0
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(3)
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL 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(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 D SORRY(AUPNQUIT) Q 0
  1.  Q 1
  1.  ;
  1.  ;
  1. POST ;
  1. REIN ;INDEX
  1.  ;S AUPNX=0 F  S AUPNX=$O(^AUPNVSIT(AUPNX)) Q:AUPNX'=+AUPNX  D
  1.  ;.S $P(^AUPNVSIT(AUPNX,11),U,14)=$$UIDV^AUPNVSIT(AUPNX)
  1.  ;.Q
  1.  K ^DD(9000010.09,0,"ID",.06)  ;kill id node
  1.  N DIK
  1.  S DIK="^AUPNPREF(",DIK(1)=".05^AE" D ENALL^DIK K DIK
  1.  S AUPNX=0 F  S AUPNX=$O(^AUPNAPPS(AUPNX)) Q:AUPNX'=+AUPNX  D
  1.  .S AUPNX1=0 F  S AUPNX1=$O(^AUPNAPPS(AUPNX,11,AUPNX1)) Q:AUPNX1'=+AUPNX1  D
  1.  ..S DIK(1)=".01",DIK="^AUPNAPPS("_AUPNX_",11,",DA=AUPNX1,DA(1)=AUPNX D ENALL^DIK
  1.  ;queue setting of 1114 field of visit file for all visits created after 10/1/00
  1.  S ZTRTN="SETNDW^AUPN9918"
  1.  S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,5),ZTDESC="SET NDW ID FIELD OF VISIT" S ZTSAVE("DUZ*")=""
  1.  D ^%ZTLOAD
  1.  K ZTRTN,ZTIO,ZTDTH,ZTDESC
  1.  ;
  1.  Q
  1.  ;
  1. SETNDW ;EP called from taskman
  1.  S X=$O(^AUPNVSIT("AMRG",2991231)),X=$O(^AUPNVSIT("AMRG",X,0))
  1.  S AUPNX=X F  S AUPNX=$O(^AUPNVSIT(AUPNX)) Q:AUPNX'=+AUPNX  D
  1.  .Q:'$D(^AUPNVSIT(AUPNX,0))
  1.  .Q:$P(^AUPNVSIT(AUPNX,0),"^",11)  ;not deleted visits
  1.  .I $P($G(^AUPNVSIT(AUPNX,11)),"^",14)="" S $P(^AUPNVSIT(AUPNX,11),"^",14)=$$UIDV^AUPNVSIT(AUPNX)
  1.  K AUPNX,X
  1.  Q
  1.  ;
  1.  ;
  1.  D BMES^XPDUTL("Delivering AUPN*99.1*15 install message to select users...")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("AUPN9915",$J)
  1.  S ^TMP("AUPN9915",$J,1)=" --- AUPN v 99.1, Patch 15, has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AUPN9915",$J,(%+1))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUPN9915"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="AGZMENU","APCDZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("AUPN9915",$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*11".
  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 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(AUPNSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(AUPNSTAL,"*",3)
  1.  D ^DIC
  1.  S AUPNY=Y
  1.  D IMES
  1.  Q $S(AUPNY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1.  ;