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

MAGQAI.m

Go to the documentation of this file. 
  1. MAGQAI ;WOIFO/RMP Imaging Utilities to support Assigning Initials [ 06/20/2001 08:57 ]
  1.  ;;3.0;IMAGING;;Mar 01, 2002
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; |                                                               |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ;ASSIGN INITIALS FOR TELNETED IMAGING FILES
  1.  Q
  1. ONE(DOMAIN) ;ADD A SINGLE DOMAIN
  1.  N INIT
  1.  S INIT=$$ASSN(DOMAIN)
  1.  S:INIT="" INIT=$$REASS(DOMAIN)
  1.  D:INIT'="" FINIT(DOMAIN,INIT)
  1.  Q INIT
  1. FINIT(DOMAIN,INIT) ;File Initials
  1.  N DIC
  1.  S DIC="^MAG(2006.19,"
  1.  S X=DOMAIN,DIC("DR")=".02///^S X=INIT"
  1.  S DIC(0)="LQ" K DD,DO D FILE^DICN
  1.  Q
  1. ASSN(VALUE) ;ASSIGN INITIALS WHILE UNIQUE
  1.  N INIT,NAME
  1.  S NAME=$P(VALUE,".")
  1.  I NAME["-" S INIT=$E(NAME,1,1)_$E($P(NAME,"-",2),1,1)
  1.  I NAME'["-" S INIT=$E(NAME,1,2)
  1.  Q $S($D(^MAG(2006.19,"C",INIT)):"",1:INIT)
  1. REASS(REP) ;ASSIGN WITH ALTERNATE
  1.  N INIT,NAME,LEN,SEC,I,TEMP
  1.  S NAME=$P(REP,"."),INIT=""
  1.  S:NAME["-" SEC=$P(REP,"-",2)
  1.  S LEN=$S(NAME["-":$L(SEC),1:$L(NAME))
  1.  F I=1:1:LEN D  Q:INIT'=""
  1.  . S TEMP=$E(NAME)_$E($S(NAME["-":SEC,1:NAME),I)
  1.  . Q:$E(TEMP,2)'?1A
  1.  . S:'$D(^MAG(2006.19,"C",TEMP)) INIT=TEMP
  1.  Q INIT
  1. DEL ;
  1.  N INDX
  1.  S INDX=0
  1.  F  S INDX=$O(^MAG(2006.19,INDX)) Q:INDX'?1N.N  D
  1.  . Q:"^40^41^42^43^44^45^46^53^78^81^94^132^"[("^"_INDX_"^")
  1.  . Q:"^136^137^151^152^157^171^180^203^208^328^329^330^"[("^"_INDX_"^")
  1.  . S DA=INDX,DR=".01///@",DIE="^MAG(2006.19,"
  1.  . D ^DIE
  1.  Q
  1. MMGRP ;CREATES REMOTE MAIL GROUP TO HANDLE IMAGE ERROR MESSAGES
  1.  N DA,DIE,DR,MAGA,MAGB,MAGC,MAGD,MAGE,MAGF,MAGG,IEN,MAGY,MAGM
  1.  ;
  1.  S MAGA="MAG SERVER" ; Mail group name
  1.  S IEN=$$FIND1^DIC(3.8,"","MX",MAGA,"","","ERR")
  1.  I +IEN=0 D
  1.  . S MAGDATA(1)=""
  1.  . S MAGDATA(2)="Creating the MAG SERVER mail group."
  1.  . D MES^XPDUTL(.MAGDATA) K MAGDATA
  1.  . S MAGB=0 ; Public
  1.  . S MAGC=.5 ; Organizer is Postmaster
  1.  . S MAGD=1 ; Self enrollment
  1.  . S MAGF(1)="Mail group to manage Image activity messages." ;Description
  1.  . S MAGG=1 ; Silent flag
  1.  . S MAGDATA=$$MG^XMBGRP(MAGA,MAGB,MAGC,MAGD,.MAGE,.MAGF,MAGG)
  1.  S MAGDATA=$S(+IEN>0:IEN,MAGDATA>0:MAGDATA,1:0)
  1.  I MAGDATA>0 D
  1.  . S MAGY(DUZ)=""
  1.  . S MAGG=1
  1.  . ;ADD installer as local mail recipient
  1.  . S IEN=$$MG^XMBGRP(MAGDATA,"","","",.MAGY,"",MAGG)
  1.  . ;Add G.MAG SERVER @ development site as remote recipient
  1.  . S MAGM="G.IMAGING DEVELOPMENT TEAM@FORUM.DOMAIN.EXT"
  1.  . I '$$FIND1^DIC(3.812,","_MAGDATA_",","MX",MAGM,"","","ERR") D
  1.  . . S MAGE(3.812,"+1,"_MAGDATA_",",.01)=MAGM
  1.  . . D UPDATE^DIE("E","MAGE")
  1.  . ;Remove development domain mailgroup reference
  1.  . S MAGX=$E("G.MAG SERVER@LAVC.ISC-WASH.DOMAIN.EXT",1,30)
  1.  . S IEN=$$FIND1^DIC(3.812,","_MAGDATA_",","MX",MAGX,"","","ERR")
  1.  . I +IEN>0 D
  1.  . . K MAGE
  1.  . . S MAGE(3.812,IEN_","_MAGDATA_",",.01)="@"
  1.  . . D UPDATE^DIE("E","MAGE")
  1.  Q
  1. JBPTR() ;
  1.  N JBPTR,X
  1.  S U="^"
  1.  S JBPTR=$S($P(^MAG(2006.1,1,1),U,6)>1:$P(^(1),U,6),+$P($G(^MAGQUEUE(2006.032,0)),U,4):$P(^(0),U,4),1:1)
  1.  S X=$G(^MAGQUEUE(2006.032,JBPTR,0))
  1.  Q $S(X="":0,1:JBPTR)