- PRCPXTRM ;WISC/RFJ-user termination, add, build array, utilities ; 11/6/06 8:46am
- ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
- ;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- ;
- TERMUSER(USERDUZ) ; remove user as inventory user from all inventory pts
- ; called internally (not by prcp options)
- ; 'Do' block modified by PRC*5.1*98 to add ODI cleanup
- I '$D(^VA(200,+USERDUZ,0)) Q
- N INVPT
- S INVPT=0 F S INVPT=$O(^PRCP(445,INVPT)) Q:'INVPT D
- . I $D(^PRCP(445,INVPT,4,USERDUZ)) D KILLUSER(INVPT,USERDUZ)
- . I $D(^PRCP(445,INVPT,9,USERDUZ)) D DEL^PRCPAODI(INVPT,USERDUZ)
- Q
- ;
- ;
- KILLUSER(INVPT,USERDUZ) ; remove user (userduz) from invpt
- I '$D(^PRCP(445,+INVPT,4,+USERDUZ)) Q
- N %,DA,DIC,DIK,X,Y
- S DIK="^PRCP(445,"_+INVPT_",4,",DA(1)=+INVPT,DA=+USERDUZ D ^DIK
- I '$O(^PRCP(445,INVPT,4,0)) D NOUSER(INVPT)
- Q
- ;
- ;
- NOUSER(INVPT) ; send mailmsg to g.irm if invpt has no users
- N INVNAME,PRCPTEXT,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ ; XMSUB,XMTEXT added with PRC*5.1*98
- S XMDUZ=.5,XMY("G.IRM")=""
- S INVNAME=$$INVNAME^PRCPUX1(INVPT)
- K PRCPTEXT
- S PRCPTEXT(1,0)="TO: G.IRM"
- S PRCPTEXT(2,0)="The inventory point "_INVNAME_" (#"_INVPT_") has NO authorized users"
- S PRCPTEXT(3,0)="(field #6 in file #445)."
- S PRCPTEXT(4,0)=" "
- S PRCPTEXT(5,0)="You can use the following mumps call to add users:"
- S PRCPTEXT(6,0)=" D ADDUSER^PRCPXTRM(INVPT,USERDUZ)"
- S PRCPTEXT(7,0)=" where INVPT is the internal inventory point number;"
- S PRCPTEXT(8,0)=" USERDUZ is the users DUZ."
- S PRCPTEXT(9,0)=" "
- S PRCPTEXT(10,0)="For example: D ADDUSER^PRCPXTRM("_INVPT_",100) would add user 100 to the"
- S PRCPTEXT(11,0)=INVNAME_" (#"_INVPT_") inventory point listed above."
- S PRCPTEXT(12,0)=" "
- S PRCPTEXT(13,0)="Once an inventory user is added, the inventory point may be inactivated"
- S PRCPTEXT(14,0)="if no longer used."
- S XMSUB="INVENTORY POINT HAS NO AUTHORIZED USERS",XMTEXT="PRCPTEXT(" D ^XMD
- Q
- ;
- ;
- ADDUSER(INVPT,USERDUZ) ; add authorized users to invpt
- I '$D(^VA(200,+USERDUZ,0)) Q
- I '$D(^PRCP(445,+INVPT,0)) Q
- I $D(^PRCP(445,+INVPT,4,+USERDUZ,0)) Q
- N %,D0,DA,DD,DIC,DINUM,DLAYGO,PRCPPRIV,X,Y ; DINUM added PRC*5.1*98
- I '$D(^PRCP(445,+INVPT,4,0)) S ^PRCP(445,+INVPT,4,0)="^445.04P^^"
- S DIC="^PRCP(445,"_+INVPT_",4,",DIC(0)="L",DLAYGO=445,DA(1)=+INVPT,(X,DINUM)=+USERDUZ,PRCPPRIV=1
- D FILE^DICN
- Q
- ;
- ;
- GETUSER(INVPT) ; build prcpxmy array of users
- ; if user is manager, set prcpxmy(duz)=1 otherwise 0
- N %,X
- K PRCPXMY
- I '$D(^PRCP(445,+INVPT,4)) Q
- S %=$P(^PRCP(445,INVPT,0),"^",3),%="PRCP"_$TR(%,"WSP","W2")_" MGRKEY"
- S X=0 F S X=$O(^PRCP(445,INVPT,4,X)) Q:'X S PRCPXMY(X)=$S($$KEY^PRCPUREP(%,X):1,1:0)
- Q
- ;
- ;
- INSTALL(SUBJECT,LINE2,TEXT) ; send install message to forum
- ; text = text to be included from line 10 and up
- N DIC,XCNP,XMDUZ,XMSUB,XMTEXT,XMZ
- S TEXT(1,0)=" ",TEXT(2,0)="Installation of IFCAP "_LINE2_" information message:",TEXT(3,0)="",TEXT(4,0)=" site: "_$G(^DD("SITE"))
- 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)),"^")
- D NOW^%DTC S Y=% D DD^%DT S TEXT(8,0)=" date@time: "_Y,TEXT(9,0)=" "
- S XMDUZ=.5,XMY("G.IFCAP INSTALL@DOMAIN.EXT")="",XMTEXT="TEXT(",XMSUB=SUBJECT
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPXTRM 3400 printed Jan 18, 2025@03:18:07 Page 2
- PRCPXTRM ;WISC/RFJ-user termination, add, build array, utilities ; 11/6/06 8:46am
- +1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- TERMUSER(USERDUZ) ; remove user as inventory user from all inventory pts
- +1 ; called internally (not by prcp options)
- +2 ; 'Do' block modified by PRC*5.1*98 to add ODI cleanup
- +3 IF '$DATA(^VA(200,+USERDUZ,0))
- QUIT
- +4 NEW INVPT
- +5 SET INVPT=0
- FOR
- SET INVPT=$ORDER(^PRCP(445,INVPT))
- if 'INVPT
- QUIT
- Begin DoDot:1
- +6 IF $DATA(^PRCP(445,INVPT,4,USERDUZ))
- DO KILLUSER(INVPT,USERDUZ)
- +7 IF $DATA(^PRCP(445,INVPT,9,USERDUZ))
- DO DEL^PRCPAODI(INVPT,USERDUZ)
- End DoDot:1
- +8 QUIT
- +9 ;
- +10 ;
- KILLUSER(INVPT,USERDUZ) ; remove user (userduz) from invpt
- +1 IF '$DATA(^PRCP(445,+INVPT,4,+USERDUZ))
- QUIT
- +2 NEW %,DA,DIC,DIK,X,Y
- +3 SET DIK="^PRCP(445,"_+INVPT_",4,"
- SET DA(1)=+INVPT
- SET DA=+USERDUZ
- DO ^DIK
- +4 IF '$ORDER(^PRCP(445,INVPT,4,0))
- DO NOUSER(INVPT)
- +5 QUIT
- +6 ;
- +7 ;
- NOUSER(INVPT) ; send mailmsg to g.irm if invpt has no users
- +1 ; XMSUB,XMTEXT added with PRC*5.1*98
- NEW INVNAME,PRCPTEXT,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +2 SET XMDUZ=.5
- SET XMY("G.IRM")=""
- +3 SET INVNAME=$$INVNAME^PRCPUX1(INVPT)
- +4 KILL PRCPTEXT
- +5 SET PRCPTEXT(1,0)="TO: G.IRM"
- +6 SET PRCPTEXT(2,0)="The inventory point "_INVNAME_" (#"_INVPT_") has NO authorized users"
- +7 SET PRCPTEXT(3,0)="(field #6 in file #445)."
- +8 SET PRCPTEXT(4,0)=" "
- +9 SET PRCPTEXT(5,0)="You can use the following mumps call to add users:"
- +10 SET PRCPTEXT(6,0)=" D ADDUSER^PRCPXTRM(INVPT,USERDUZ)"
- +11 SET PRCPTEXT(7,0)=" where INVPT is the internal inventory point number;"
- +12 SET PRCPTEXT(8,0)=" USERDUZ is the users DUZ."
- +13 SET PRCPTEXT(9,0)=" "
- +14 SET PRCPTEXT(10,0)="For example: D ADDUSER^PRCPXTRM("_INVPT_",100) would add user 100 to the"
- +15 SET PRCPTEXT(11,0)=INVNAME_" (#"_INVPT_") inventory point listed above."
- +16 SET PRCPTEXT(12,0)=" "
- +17 SET PRCPTEXT(13,0)="Once an inventory user is added, the inventory point may be inactivated"
- +18 SET PRCPTEXT(14,0)="if no longer used."
- +19 SET XMSUB="INVENTORY POINT HAS NO AUTHORIZED USERS"
- SET XMTEXT="PRCPTEXT("
- DO ^XMD
- +20 QUIT
- +21 ;
- +22 ;
- ADDUSER(INVPT,USERDUZ) ; add authorized users to invpt
- +1 IF '$DATA(^VA(200,+USERDUZ,0))
- QUIT
- +2 IF '$DATA(^PRCP(445,+INVPT,0))
- QUIT
- +3 IF $DATA(^PRCP(445,+INVPT,4,+USERDUZ,0))
- QUIT
- +4 ; DINUM added PRC*5.1*98
- NEW %,D0,DA,DD,DIC,DINUM,DLAYGO,PRCPPRIV,X,Y
- +5 IF '$DATA(^PRCP(445,+INVPT,4,0))
- SET ^PRCP(445,+INVPT,4,0)="^445.04P^^"
- +6 SET DIC="^PRCP(445,"_+INVPT_",4,"
- SET DIC(0)="L"
- SET DLAYGO=445
- SET DA(1)=+INVPT
- SET (X,DINUM)=+USERDUZ
- SET PRCPPRIV=1
- +7 DO FILE^DICN
- +8 QUIT
- +9 ;
- +10 ;
- GETUSER(INVPT) ; build prcpxmy array of users
- +1 ; if user is manager, set prcpxmy(duz)=1 otherwise 0
- +2 NEW %,X
- +3 KILL PRCPXMY
- +4 IF '$DATA(^PRCP(445,+INVPT,4))
- QUIT
- +5 SET %=$PIECE(^PRCP(445,INVPT,0),"^",3)
- SET %="PRCP"_$TRANSLATE(%,"WSP","W2")_" MGRKEY"
- +6 SET X=0
- FOR
- SET X=$ORDER(^PRCP(445,INVPT,4,X))
- if 'X
- QUIT
- SET PRCPXMY(X)=$SELECT($$KEY^PRCPUREP(%,X):1,1:0)
- +7 QUIT
- +8 ;
- +9 ;
- INSTALL(SUBJECT,LINE2,TEXT) ; send install message to forum
- +1 ; text = text to be included from line 10 and up
- +2 NEW DIC,XCNP,XMDUZ,XMSUB,XMTEXT,XMZ
- +3 SET TEXT(1,0)=" "
- SET TEXT(2,0)="Installation of IFCAP "_LINE2_" information message:"
- SET TEXT(3,0)=""
- SET TEXT(4,0)=" site: "_$GET(^DD("SITE"))
- +4 XECUTE ^%ZOSF("UCI")
- SET TEXT(5,0)=" op sys: "_$PIECE($GET(^%ZOSF("OS")),"^")
- SET TEXT(6,0)=" uci: "_Y
- SET TEXT(7,0)=" user: "_$PIECE($GET(^VA(200,+DUZ,0)),"^")
- +5 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET TEXT(8,0)=" date@time: "_Y
- SET TEXT(9,0)=" "
- +6 SET XMDUZ=.5
- SET XMY("G.IFCAP INSTALL@DOMAIN.EXT")=""
- SET XMTEXT="TEXT("
- SET XMSUB=SUBJECT
- +7 DO ^XMD
- +8 QUIT