source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQAI.m@ 1732

Last change on this file since 1732 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1MAGQAI ;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
20ONE(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
26FINIT(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
32ASSN(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)
38REASS(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
48DEL ;
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
57MMGRP ;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
91JBPTR() ;
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)
Note: See TracBrowser for help on using the repository browser.