source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPXTRM.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1PRCPXTRM ;WISC/RFJ-user termination, add, build array, utilities ; 11/6/06 8:46am
2 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ;
7TERMUSER(USERDUZ) ; remove user as inventory user from all inventory pts
8 ; called internally (not by prcp options)
9 ; 'Do' block modified by PRC*5.1*98 to add ODI cleanup
10 I '$D(^VA(200,+USERDUZ,0)) Q
11 N INVPT
12 S INVPT=0 F S INVPT=$O(^PRCP(445,INVPT)) Q:'INVPT D
13 . I $D(^PRCP(445,INVPT,4,USERDUZ)) D KILLUSER(INVPT,USERDUZ)
14 . I $D(^PRCP(445,INVPT,9,USERDUZ)) D DEL^PRCPAODI(INVPT,USERDUZ)
15 Q
16 ;
17 ;
18KILLUSER(INVPT,USERDUZ) ; remove user (userduz) from invpt
19 I '$D(^PRCP(445,+INVPT,4,+USERDUZ)) Q
20 N %,DA,DIC,DIK,X,Y
21 S DIK="^PRCP(445,"_+INVPT_",4,",DA(1)=+INVPT,DA=+USERDUZ D ^DIK
22 I '$O(^PRCP(445,INVPT,4,0)) D NOUSER(INVPT)
23 Q
24 ;
25 ;
26NOUSER(INVPT) ; send mailmsg to g.irm if invpt has no users
27 N INVNAME,PRCPTEXT,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ ; XMSUB,XMTEXT added with PRC*5.1*98
28 S XMDUZ=.5,XMY("G.IRM")=""
29 S INVNAME=$$INVNAME^PRCPUX1(INVPT)
30 K PRCPTEXT
31 S PRCPTEXT(1,0)="TO: G.IRM"
32 S PRCPTEXT(2,0)="The inventory point "_INVNAME_" (#"_INVPT_") has NO authorized users"
33 S PRCPTEXT(3,0)="(field #6 in file #445)."
34 S PRCPTEXT(4,0)=" "
35 S PRCPTEXT(5,0)="You can use the following mumps call to add users:"
36 S PRCPTEXT(6,0)=" D ADDUSER^PRCPXTRM(INVPT,USERDUZ)"
37 S PRCPTEXT(7,0)=" where INVPT is the internal inventory point number;"
38 S PRCPTEXT(8,0)=" USERDUZ is the users DUZ."
39 S PRCPTEXT(9,0)=" "
40 S PRCPTEXT(10,0)="For example: D ADDUSER^PRCPXTRM("_INVPT_",100) would add user 100 to the"
41 S PRCPTEXT(11,0)=INVNAME_" (#"_INVPT_") inventory point listed above."
42 S PRCPTEXT(12,0)=" "
43 S PRCPTEXT(13,0)="Once an inventory user is added, the inventory point may be inactivated"
44 S PRCPTEXT(14,0)="if no longer used."
45 S XMSUB="INVENTORY POINT HAS NO AUTHORIZED USERS",XMTEXT="PRCPTEXT(" D ^XMD
46 Q
47 ;
48 ;
49ADDUSER(INVPT,USERDUZ) ; add authorized users to invpt
50 I '$D(^VA(200,+USERDUZ,0)) Q
51 I '$D(^PRCP(445,+INVPT,0)) Q
52 I $D(^PRCP(445,+INVPT,4,+USERDUZ,0)) Q
53 N %,D0,DA,DD,DIC,DINUM,DLAYGO,PRCPPRIV,X,Y ; DINUM added PRC*5.1*98
54 I '$D(^PRCP(445,+INVPT,4,0)) S ^PRCP(445,+INVPT,4,0)="^445.04P^^"
55 S DIC="^PRCP(445,"_+INVPT_",4,",DIC(0)="L",DLAYGO=445,DA(1)=+INVPT,(X,DINUM)=+USERDUZ,PRCPPRIV=1
56 D FILE^DICN
57 Q
58 ;
59 ;
60GETUSER(INVPT) ; build prcpxmy array of users
61 ; if user is manager, set prcpxmy(duz)=1 otherwise 0
62 N %,X
63 K PRCPXMY
64 I '$D(^PRCP(445,+INVPT,4)) Q
65 S %=$P(^PRCP(445,INVPT,0),"^",3),%="PRCP"_$TR(%,"WSP","W2")_" MGRKEY"
66 S X=0 F S X=$O(^PRCP(445,INVPT,4,X)) Q:'X S PRCPXMY(X)=$S($$KEY^PRCPUREP(%,X):1,1:0)
67 Q
68 ;
69 ;
70INSTALL(SUBJECT,LINE2,TEXT) ; send install message to forum
71 ; text = text to be included from line 10 and up
72 N DIC,XCNP,XMDUZ,XMSUB,XMTEXT,XMZ
73 S TEXT(1,0)=" ",TEXT(2,0)="Installation of IFCAP "_LINE2_" information message:",TEXT(3,0)="",TEXT(4,0)=" site: "_$G(^DD("SITE"))
74 X ^%ZOSF("UCI") S TEXT(5,0)=" op sys: "_$P($G(^%ZOSF("OS")),"^"),TEXT(6,0)=" uci: "_Y,TEXT(7,0)=" user: "_$P($G(^VA(200,+DUZ,0)),"^")
75 D NOW^%DTC S Y=% D DD^%DT S TEXT(8,0)=" date@time: "_Y,TEXT(9,0)=" "
76 S XMDUZ=.5,XMY("G.IFCAP INSTALL@FORUM.VA.GOV")="",XMTEXT="TEXT(",XMSUB=SUBJECT
77 D ^XMD
78 Q
Note: See TracBrowser for help on using the repository browser.