source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQAI.m@ 1005

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