| [613] | 1 | MAGQAI ;WOIFO/RMP Imaging Utilities to support Assigning Initials [ 06/20/2001 08:57 ]
|
|---|
| 2 | ;;3.0;IMAGING;;Mar 01, 2002
|
|---|
| 3 | ;; +---------------------------------------------------------------+
|
|---|
| 4 | ;; | Property of the US Government. |
|
|---|
| 5 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 6 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 7 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 8 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 9 | ;; | telephone (301) 734-0100. |
|
|---|
| 10 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | ;ASSIGN INITIALS FOR TELNETED IMAGING FILES
|
|---|
| 19 | Q
|
|---|
| 20 | ONE(DOMAIN) ;ADD A SINGLE DOMAIN
|
|---|
| 21 | N INIT
|
|---|
| 22 | S INIT=$$ASSN(DOMAIN)
|
|---|
| 23 | S:INIT="" INIT=$$REASS(DOMAIN)
|
|---|
| 24 | D:INIT'="" FINIT(DOMAIN,INIT)
|
|---|
| 25 | Q INIT
|
|---|
| 26 | FINIT(DOMAIN,INIT) ;File Initials
|
|---|
| 27 | N DIC
|
|---|
| 28 | S DIC="^MAG(2006.19,"
|
|---|
| 29 | S X=DOMAIN,DIC("DR")=".02///^S X=INIT"
|
|---|
| 30 | S DIC(0)="LQ" K DD,DO D FILE^DICN
|
|---|
| 31 | Q
|
|---|
| 32 | ASSN(VALUE) ;ASSIGN INITIALS WHILE UNIQUE
|
|---|
| 33 | N INIT,NAME
|
|---|
| 34 | S NAME=$P(VALUE,".")
|
|---|
| 35 | I NAME["-" S INIT=$E(NAME,1,1)_$E($P(NAME,"-",2),1,1)
|
|---|
| 36 | I NAME'["-" S INIT=$E(NAME,1,2)
|
|---|
| 37 | Q $S($D(^MAG(2006.19,"C",INIT)):"",1:INIT)
|
|---|
| 38 | REASS(REP) ;ASSIGN WITH ALTERNATE
|
|---|
| 39 | N INIT,NAME,LEN,SEC,I,TEMP
|
|---|
| 40 | S NAME=$P(REP,"."),INIT=""
|
|---|
| 41 | S:NAME["-" SEC=$P(REP,"-",2)
|
|---|
| 42 | S LEN=$S(NAME["-":$L(SEC),1:$L(NAME))
|
|---|
| 43 | F I=1:1:LEN D Q:INIT'=""
|
|---|
| 44 | . S TEMP=$E(NAME)_$E($S(NAME["-":SEC,1:NAME),I)
|
|---|
| 45 | . Q:$E(TEMP,2)'?1A
|
|---|
| 46 | . S:'$D(^MAG(2006.19,"C",TEMP)) INIT=TEMP
|
|---|
| 47 | Q INIT
|
|---|
| 48 | DEL ;
|
|---|
| 49 | N INDX
|
|---|
| 50 | S INDX=0
|
|---|
| 51 | F S INDX=$O(^MAG(2006.19,INDX)) Q:INDX'?1N.N D
|
|---|
| 52 | . Q:"^40^41^42^43^44^45^46^53^78^81^94^132^"[("^"_INDX_"^")
|
|---|
| 53 | . Q:"^136^137^151^152^157^171^180^203^208^328^329^330^"[("^"_INDX_"^")
|
|---|
| 54 | . S DA=INDX,DR=".01///@",DIE="^MAG(2006.19,"
|
|---|
| 55 | . D ^DIE
|
|---|
| 56 | Q
|
|---|
| 57 | MMGRP ;CREATES REMOTE MAIL GROUP TO HANDLE IMAGE ERROR MESSAGES
|
|---|
| 58 | N DA,DIE,DR,MAGA,MAGB,MAGC,MAGD,MAGE,MAGF,MAGG,IEN,MAGY,MAGM
|
|---|
| 59 | ;
|
|---|
| 60 | S MAGA="MAG SERVER" ; Mail group name
|
|---|
| 61 | S IEN=$$FIND1^DIC(3.8,"","MX",MAGA,"","","ERR")
|
|---|
| 62 | I +IEN=0 D
|
|---|
| 63 | . S MAGDATA(1)=""
|
|---|
| 64 | . S MAGDATA(2)="Creating the MAG SERVER mail group."
|
|---|
| 65 | . D MES^XPDUTL(.MAGDATA) K MAGDATA
|
|---|
| 66 | . S MAGB=0 ; Public
|
|---|
| 67 | . S MAGC=.5 ; Organizer is Postmaster
|
|---|
| 68 | . S MAGD=1 ; Self enrollment
|
|---|
| 69 | . S MAGF(1)="Mail group to manage Image activity messages." ;Description
|
|---|
| 70 | . S MAGG=1 ; Silent flag
|
|---|
| 71 | . S MAGDATA=$$MG^XMBGRP(MAGA,MAGB,MAGC,MAGD,.MAGE,.MAGF,MAGG)
|
|---|
| 72 | S MAGDATA=$S(+IEN>0:IEN,MAGDATA>0:MAGDATA,1:0)
|
|---|
| 73 | I MAGDATA>0 D
|
|---|
| 74 | . S MAGY(DUZ)=""
|
|---|
| 75 | . S MAGG=1
|
|---|
| 76 | . ;ADD installer as local mail recipient
|
|---|
| 77 | . S IEN=$$MG^XMBGRP(MAGDATA,"","","",.MAGY,"",MAGG)
|
|---|
| 78 | . ;Add G.MAG SERVER @ development site as remote recipient
|
|---|
| 79 | . S MAGM="G.IMAGING DEVELOPMENT TEAM@FORUM.VA.GOV"
|
|---|
| 80 | . I '$$FIND1^DIC(3.812,","_MAGDATA_",","MX",MAGM,"","","ERR") D
|
|---|
| 81 | . . S MAGE(3.812,"+1,"_MAGDATA_",",.01)=MAGM
|
|---|
| 82 | . . D UPDATE^DIE("E","MAGE")
|
|---|
| 83 | . ;Remove development domain mailgroup reference
|
|---|
| 84 | . S MAGX=$E("G.MAG SERVER@LAVC.ISC-WASH.VA.GOV",1,30)
|
|---|
| 85 | . S IEN=$$FIND1^DIC(3.812,","_MAGDATA_",","MX",MAGX,"","","ERR")
|
|---|
| 86 | . I +IEN>0 D
|
|---|
| 87 | . . K MAGE
|
|---|
| 88 | . . S MAGE(3.812,IEN_","_MAGDATA_",",.01)="@"
|
|---|
| 89 | . . D UPDATE^DIE("E","MAGE")
|
|---|
| 90 | Q
|
|---|
| 91 | JBPTR() ;
|
|---|
| 92 | N JBPTR,X
|
|---|
| 93 | S U="^"
|
|---|
| 94 | 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)
|
|---|
| 95 | S X=$G(^MAGQUEUE(2006.032,JBPTR,0))
|
|---|
| 96 | Q $S(X="":0,1:JBPTR)
|
|---|
