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

LEX2I03P.m

Go to the documentation of this file. 
  1. LEX2I03P ;IHS/OIT/FCJ - LEXICON UTILITY PATCH 1003 ; 14 Mar 2012  12:44 PM
  1.  ;;2.0;LEXICON UTILITY;**1003**;Sep 23, 1996;Build 10
  1.  ;=================================================================
  1.  ;Original routine from LEX2I02P
  1.  ;
  1. POST ;EP FROM KERNAL
  1.  S %="HIST^LEX2I03P"
  1.  I $$NEWCP^XPDUTL("POS4-"_%,%)
  1.  S %="UNCD^LEX2I03P"
  1.  I $$NEWCP^XPDUTL("POS5-"_%,%)
  1.  S %="MAIL^LEX2I03P"
  1.  I $$NEWCP^XPDUTL("POS6-"_%,%)
  1.  ;
  1.  Q
  1. MAIL ;
  1.  D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("LEX1003",$J)
  1.  D RSLT(" --- LEX v 2.0 Patch 1003, have been installed into this namespace ---")
  1.  F %=1:1 D RSLT($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(^(%,0))
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""LEX1003"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="LEXZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("LEX1003",$J)
  1.  D MES^XPDUTL("END Delivering MailMan message to select users.")
  1.  Q
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("LEX1003",$J,0))+1,^(^(0))=%
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a key
  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. GREET ;;To add to mail message.
  1.  ;;  
  1.  ;;Routines and/or data dictionaries on your RPMS system have been updated.
  1.  ;;  
  1.  ;;You are receiving this message because of the RPMS
  1.  ;;security keys that you hold.  This is for your information.
  1.  ;;Do not respond to this message.
  1.  ;;  
  1.  ;;Questions about this patch may be directed to
  1.  ;;the ITSC Support Center, at 505-248-4371,
  1.  ;;refer to patch "LEX*2.1*1003".
  1.  ;;  
  1.  ;;###;NOTE: This line end of text.
  1.  ;
  1. HIST ;PATCH HISTORY UPDATE
  1.  D MES^XPDUTL("Begin adding patches to package file.")
  1.  S DDLM=";;",DLM="|",TAG="LEX"
  1.  S PKGNM="LEXICON UTILITY"
  1.  I '$D(^DIC(9.4,"B",PKGNM)) D MES^XPDUTL("Problem with package name.") Q
  1.  S PKGIEN=$O(^DIC(9.4,"B",PKGNM,0))
  1.  F I=1:1  D  Q:TEXT["END"
  1.  .S TEXT=$T(@TAG+I) Q:TEXT["END"
  1.  .S DATA=$P(TEXT,DDLM,2)
  1.  .S VERSION=$P(DATA,DLM,2),PATCH=$P(DATA,DLM,3)
  1.  .S VSB=$O(^DIC(9.4,PKGIEN,22,"B",VERSION,0))
  1.  .Q:'VSB
  1.  .K FDA
  1.  .; Do not update if the patch is already in the patch history
  1.  .Q:$D(^DIC(9.4,PKGIEN,22,VSB,"PAH","B",PATCH))
  1.  .S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.01)=$G(PATCH)
  1.  .S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.02)=DT
  1.  .S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.03)=DUZ
  1.  .D UPDATE^DIE(,"FDA")
  1.  .D:$G(DIERR)'="" MES^XPDUTL("Error adding patch "_PATCH_" to package file.")
  1.  D MES^XPDUTL("Completed adding patches to package file.")
  1.  Q
  1. UNCD ;ADD UNCODED DX CODES
  1.  Q:$D(^LEX(757.02,"CODE",".9999 "))
  1.  F UNCD=".9999","ZZZ.999" D
  1.  .S DIC="^LEX(757.02,",X="Uncoded Diagnosis",DIC(0)="LI",DLAYGO=757.02,DIADD=1
  1.  .S CLS=$S(UNCD=".9999":1,1:30)
  1.  .S DIC("DR")="1////"_UNCD_";2////"_CLS_";3////155739;4////0;6////0"
  1.  .D ^DIC I +Y<0 W !,"Uable to add the uncoded DX ",UNCD Q
  1.  .S DA(1)=+Y,DIC="^LEX(757.02,"_DA(1)_",4,",DIC(0)="LI"
  1.  .S ^LEX(757.02,DA(1),4,0)="^757.28DA^0^0"
  1.  .I UNCD=".9999" D  Q
  1.  ..S DA=1,X=2781001,DIC("DR")="1////1" D ^DIC I +Y<0 W !,"Uable to add the uncoded DX ",UNCD," active date." Q
  1.  ..S DA=2,X=3141001,DIC("DR")="1////0" D ^DIC I +Y<0 W !,"Uable to add the uncoded DX ",UNCD," inactive date." Q
  1.  .S DA=1,X=3141001,DIC("DR")="1////1" D ^DIC I +Y<0 W !,"Uable to add the uncoded DX ",UNCD," active date."
  1.  K UNCD,CLS,DIADD,DIC,DA
  1.  Q
  1.  ;;;;FORMAT - Package name|Version|Patch|Sequence
  1. LEX ;
  1.  ;;LEXICON UTILITY|2.0|79 SEQ #72
  1.  ;;LEXICON UTILITY|2.0|82 SEQ #74
  1.  ;;LEXICON UTILITY|2.0|83 SEQ #75
  1.  ;;LEXICON UTILITY|2.0|84 SEQ #76
  1.  ;;LEXICON UTILITY|2.0|51 SEQ #77
  1.  ;;LEXICON UTILITY|2.0|58 SEQ #78
  1.  ;;LEXICON UTILITY|2.0|89 SEQ #79
  1.  ;;LEXICON UTILITY|2.0|90 SEQ #80
  1.  ;;LEXICON UTILITY|2.0|91 SEQ #81
  1.  ;;LEXICON UTILITY|2.0|93 SEQ #82
  1.  ;;LEXICON UTILITY|2.0|94 SEQ #83
  1.  ;;LEXICON UTILITY|2.0|80
  1.  ;END