HMPEASU ;SLC/GRR,ASMR/RRB - Serve VistA reference data as JSON via RPC;10/18/12 6:26pm
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CLASS ; -- USR Class file #8930
N PRV S PRV=+$G(HMPLAST)
S HMPCNT=$$TOTAL^HMPEF("^USR(8930)")
I PRV=0 S PRV=.9
I $L(HMPID) D CLS1(HMPID) Q
F S PRV=$O(^USR(8930,PRV)) Q:PRV'>0 D CLS1(PRV) I HMPMAX,HMPI'<HMPMAX Q
I PRV'>0 S HMPFINI=1
Q
;
CLS1(IEN) ;
N $ES,$ET,ERRMSG
S ERRMSG=$$ERRMSG^HMPEF("User Class",IEN)
S $ET="D ERRHDLR^HMPDERRH"
N HMPV,FLDS,X,Y,INREC
K HMPV S FLDS=".01:.05;1*"
D GETS^DIQ(8930,IEN_",",FLDS,"IEN","HMPV")
S Y=$NA(HMPV(8930,IEN_","))
S INREC("name")=$G(@Y@(.01,"E"))
S INREC("localId")=IEN,INREC("uid")=$$SETUID^HMPUTILS("asu-class",,IEN)
S INREC("abbreviation")=$G(@Y@(.02,"E")),INREC("active")=$S($G(@Y@(.03,"I"))=1:"true",1:"false")
S INREC("displayName")=$G(@Y@(.04,"E"))
I $D(HMPV("8930.01")) D
. N IEN2,ID,CNT
. S IEN2="",CNT=0
. F S IEN2=$O(HMPV(8930.01,IEN2)) Q:IEN2="" D
. . S CNT=CNT+1,INREC("subClass",CNT,"name")=HMPV("8930.01",IEN2,".01","E")
. . S ID=HMPV(8930.01,IEN2,.01,"I"),INREC("subClass",CNT,"uid")=$$SETUID^HMPUTILS("asu-class",,ID)
D ADD^HMPEF("INREC") S HMPLAST=IEN
Q
;
RULE ; -- USR Authorization/Subscription file #8930.1
N PRV S PRV=+$G(HMPLAST)
S HMPCNT=$$TOTAL^HMPEF("^USR(8930.1)")
I PRV=0 S PRV=.9
I $L(HMPID) D RULE1(HMPID) Q
F S PRV=$O(^USR(8930.1,PRV)) Q:PRV'>0 D RULE1(PRV) I HMPMAX,HMPI'<HMPMAX Q
I PRV'>0 S HMPFINI=1
Q
;
RULE1(IEN) ;
N $ES,$ET,ERRMSG
S ERRMSG=$$ERRMSG^HMPEF("ASU Rule",IEN)
S $ET="D ERRHDLR^HMPDERRH"
N HMPV,FLDS,X,Y,INREC,DESC
K HMPV S FLDS=".01:1"
D GETS^DIQ(8930.1,IEN_",",FLDS,"IEN","HMPV")
S Y=$NA(HMPV(8930.1,IEN_","))
S INREC("localId")=IEN,INREC("uid")=$$SETUID^HMPUTILS("asu-rule",,IEN)
S X=$G(@Y@(.01,"I")) S:X INREC("docDefUid")=$$SETUID^HMPUTILS("doc-def",,X),INREC("docDefName")=$G(@Y@(.01,"E"))
S X=$G(@Y@(.02,"I")) S:X INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X),INREC("statusName")=$G(@Y@(.02,"E"))
S X=$G(@Y@(.03,"I")) S:X INREC("actionUid")=$$SETUID^HMPUTILS("doc-action",,X),INREC("actionName")=$G(@Y@(.03,"E"))
S X=$G(@Y@(.04,"I")) S:X INREC("userClassUid")=$$SETUID^HMPUTILS("asu-class",,X),INREC("userClassName")=$G(@Y@(.04,"E"))
S X=$G(@Y@(.05,"I")),INREC("isAnd")=$S(X="&":"true",1:"false") ;,INREC("isOr")=$S(X="!":"true",1:"false")
S X=$G(@Y@(.06,"I")) S:X INREC("userRoleUid")=$$SETUID^HMPUTILS("asu-role",,X),INREC("userRoleName")=$G(@Y@(.06,"E"))
I $D(@Y@(1)) D
. N I S I=0 F S I=$O(@Y@(1,I)) Q:I<1 S DESC(I)=@Y@(1,I)
. S INREC("description")=$$STRING^HMPD(.DESC)
D ADD^HMPEF("INREC") S HMPLAST=IEN
Q
;
DEF ; -- TIU Document Definition file #8925.1
N PRV S PRV=+$G(HMPLAST)
S HMPCNT=$$TOTAL^HMPEF("^TIU(8925.1)")
I PRV=0 S PRV=.9
I $L(HMPID) D DEF1(HMPID) Q
F S PRV=$O(^TIU(8925.1,PRV)) Q:PRV'>0 D DEF1(PRV) I HMPMAX,HMPI'<HMPMAX Q ;ICR 2700 DE2818 ASF 11/21/15
I PRV'>0 S HMPFINI=1
Q
;
DEF1(IEN) ;
N $ES,$ET,ERRMSG
S ERRMSG=$$ERRMSG^HMPEF("TIU Doc Def",IEN)
S $ET="D ERRHDLR^HMPDERRH"
N HMPV,FLDS,X,Y,I,INREC
K HMPV S FLDS=".01:.14;1501"
D GETS^DIQ(8925.1,IEN_",",FLDS,"IEN","HMPV")
S Y=$NA(HMPV(8925.1,IEN_","))
S INREC("name")=$G(@Y@(.01,"E"))
S INREC("uid")=$$SETUID^HMPUTILS("doc-def",,IEN)
S INREC("abbreviation")=$G(@Y@(.02,"E"))
S INREC("displayName")=$G(@Y@(.03,"E"))
S INREC("typeName")=$G(@Y@(.04,"E"))
S INREC("typeUid")=$$SETUID^HMPUTILS("doc-type",,$G(@Y@(.04,"I")))
S X=$G(@Y@(.05,"I")) I X D
. S INREC("ownerUid")=$$SETUID^HMPUTILS("user",,X)
. S INREC("ownerName")=$G(@Y@(.05,"E"))
S X=$G(@Y@(.06,"I")) S:X INREC("classOwner")=$$SETUID^HMPUTILS("asu-class",,X)
S X=$G(@Y@(.07,"I")) I X D
. S INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X)
. S INREC("statusName")=$G(@Y@(.07,"E"))
S X=$G(@Y@(.1,"I")) S:X INREC("shared")="true"
S X=$G(@Y@(.13,"I")) S:X INREC("nationalStandard")="true"
S X=$G(@Y@(.14,"I")) S:X INREC("postingCode")=$$SETUID^HMPUTILS("doc-posting",,X)
S I=0 F S I=$O(^TIU(8925.1,IEN,10,I)) Q:I<1 S X=+$G(^(I,0)) D ;ICR 2700 DE2818 ASF 11/21/15
. S INREC("item",I,"uid")=$$SETUID^HMPUTILS("doc-def",,X)
. S INREC("item",I,"name")=$$GET1^DIQ(8925.1,X_",",.01)
; national title info
S X=$G(@Y@(1501,"I")) I X D ;National Title + attributes
. N IENS,TIU,DA,FNUM,NAME
. S IENS=X_"," D GETS^DIQ(8926.1,IENS,"*","IE","TIU")
. S INREC("nationalTitle","vuid")="urn:va:vuid:"_$G(TIU(8926.1,IENS,99.99,"E"))
. S INREC("nationalTitle","name")=$G(TIU(8926.1,IENS,.01,"E"))
. F I=".04^Subject^2",".05^Role^3",".06^Setting^4",".07^Service^5",".08^Type^6" D
.. S DA=+$G(TIU(8926.1,IENS,+I,"I")) Q:DA'>0
.. S FNUM="8926."_+$P(I,U,3),NAME=$$LOW^XLFSTR($P(I,U,2))
.. S INREC("nationalTitle"_$P(I,U,2),"vuid")="urn:va:vuid:"_$$VUID^HMPD(DA,FNUM)
.. S INREC("nationalTitle"_$P(I,U,2),"name")=$G(TIU(8926.1,IENS,+I,"E"))
;
D ADD^HMPEF("INREC") S HMPLAST=IEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPEASU 5053 printed Sep 15, 2024@21:17:55 Page 2
HMPEASU ;SLC/GRR,ASMR/RRB - Serve VistA reference data as JSON via RPC;10/18/12 6:26pm
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CLASS ; -- USR Class file #8930
+1 NEW PRV
SET PRV=+$GET(HMPLAST)
+2 SET HMPCNT=$$TOTAL^HMPEF("^USR(8930)")
+3 IF PRV=0
SET PRV=.9
+4 IF $LENGTH(HMPID)
DO CLS1(HMPID)
QUIT
+5 FOR
SET PRV=$ORDER(^USR(8930,PRV))
if PRV'>0
QUIT
DO CLS1(PRV)
IF HMPMAX
IF HMPI'<HMPMAX
QUIT
+6 IF PRV'>0
SET HMPFINI=1
+7 QUIT
+8 ;
CLS1(IEN) ;
+1 NEW $ESTACK,$ETRAP,ERRMSG
+2 SET ERRMSG=$$ERRMSG^HMPEF("User Class",IEN)
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
+4 NEW HMPV,FLDS,X,Y,INREC
+5 KILL HMPV
SET FLDS=".01:.05;1*"
+6 DO GETS^DIQ(8930,IEN_",",FLDS,"IEN","HMPV")
+7 SET Y=$NAME(HMPV(8930,IEN_","))
+8 SET INREC("name")=$GET(@Y@(.01,"E"))
+9 SET INREC("localId")=IEN
SET INREC("uid")=$$SETUID^HMPUTILS("asu-class",,IEN)
+10 SET INREC("abbreviation")=$GET(@Y@(.02,"E"))
SET INREC("active")=$SELECT($GET(@Y@(.03,"I"))=1:"true",1:"false")
+11 SET INREC("displayName")=$GET(@Y@(.04,"E"))
+12 IF $DATA(HMPV("8930.01"))
Begin DoDot:1
+13 NEW IEN2,ID,CNT
+14 SET IEN2=""
SET CNT=0
+15 FOR
SET IEN2=$ORDER(HMPV(8930.01,IEN2))
if IEN2=""
QUIT
Begin DoDot:2
+16 SET CNT=CNT+1
SET INREC("subClass",CNT,"name")=HMPV("8930.01",IEN2,".01","E")
+17 SET ID=HMPV(8930.01,IEN2,.01,"I")
SET INREC("subClass",CNT,"uid")=$$SETUID^HMPUTILS("asu-class",,ID)
End DoDot:2
End DoDot:1
+18 DO ADD^HMPEF("INREC")
SET HMPLAST=IEN
+19 QUIT
+20 ;
RULE ; -- USR Authorization/Subscription file #8930.1
+1 NEW PRV
SET PRV=+$GET(HMPLAST)
+2 SET HMPCNT=$$TOTAL^HMPEF("^USR(8930.1)")
+3 IF PRV=0
SET PRV=.9
+4 IF $LENGTH(HMPID)
DO RULE1(HMPID)
QUIT
+5 FOR
SET PRV=$ORDER(^USR(8930.1,PRV))
if PRV'>0
QUIT
DO RULE1(PRV)
IF HMPMAX
IF HMPI'<HMPMAX
QUIT
+6 IF PRV'>0
SET HMPFINI=1
+7 QUIT
+8 ;
RULE1(IEN) ;
+1 NEW $ESTACK,$ETRAP,ERRMSG
+2 SET ERRMSG=$$ERRMSG^HMPEF("ASU Rule",IEN)
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
+4 NEW HMPV,FLDS,X,Y,INREC,DESC
+5 KILL HMPV
SET FLDS=".01:1"
+6 DO GETS^DIQ(8930.1,IEN_",",FLDS,"IEN","HMPV")
+7 SET Y=$NAME(HMPV(8930.1,IEN_","))
+8 SET INREC("localId")=IEN
SET INREC("uid")=$$SETUID^HMPUTILS("asu-rule",,IEN)
+9 SET X=$GET(@Y@(.01,"I"))
if X
SET INREC("docDefUid")=$$SETUID^HMPUTILS("doc-def",,X)
SET INREC("docDefName")=$GET(@Y@(.01,"E"))
+10 SET X=$GET(@Y@(.02,"I"))
if X
SET INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X)
SET INREC("statusName")=$GET(@Y@(.02,"E"))
+11 SET X=$GET(@Y@(.03,"I"))
if X
SET INREC("actionUid")=$$SETUID^HMPUTILS("doc-action",,X)
SET INREC("actionName")=$GET(@Y@(.03,"E"))
+12 SET X=$GET(@Y@(.04,"I"))
if X
SET INREC("userClassUid")=$$SETUID^HMPUTILS("asu-class",,X)
SET INREC("userClassName")=$GET(@Y@(.04,"E"))
+13 ;,INREC("isOr")=$S(X="!":"true",1:"false")
SET X=$GET(@Y@(.05,"I"))
SET INREC("isAnd")=$SELECT(X="&":"true",1:"false")
+14 SET X=$GET(@Y@(.06,"I"))
if X
SET INREC("userRoleUid")=$$SETUID^HMPUTILS("asu-role",,X)
SET INREC("userRoleName")=$GET(@Y@(.06,"E"))
+15 IF $DATA(@Y@(1))
Begin DoDot:1
+16 NEW I
SET I=0
FOR
SET I=$ORDER(@Y@(1,I))
if I<1
QUIT
SET DESC(I)=@Y@(1,I)
+17 SET INREC("description")=$$STRING^HMPD(.DESC)
End DoDot:1
+18 DO ADD^HMPEF("INREC")
SET HMPLAST=IEN
+19 QUIT
+20 ;
DEF ; -- TIU Document Definition file #8925.1
+1 NEW PRV
SET PRV=+$GET(HMPLAST)
+2 SET HMPCNT=$$TOTAL^HMPEF("^TIU(8925.1)")
+3 IF PRV=0
SET PRV=.9
+4 IF $LENGTH(HMPID)
DO DEF1(HMPID)
QUIT
+5 ;ICR 2700 DE2818 ASF 11/21/15
FOR
SET PRV=$ORDER(^TIU(8925.1,PRV))
if PRV'>0
QUIT
DO DEF1(PRV)
IF HMPMAX
IF HMPI'<HMPMAX
QUIT
+6 IF PRV'>0
SET HMPFINI=1
+7 QUIT
+8 ;
DEF1(IEN) ;
+1 NEW $ESTACK,$ETRAP,ERRMSG
+2 SET ERRMSG=$$ERRMSG^HMPEF("TIU Doc Def",IEN)
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
+4 NEW HMPV,FLDS,X,Y,I,INREC
+5 KILL HMPV
SET FLDS=".01:.14;1501"
+6 DO GETS^DIQ(8925.1,IEN_",",FLDS,"IEN","HMPV")
+7 SET Y=$NAME(HMPV(8925.1,IEN_","))
+8 SET INREC("name")=$GET(@Y@(.01,"E"))
+9 SET INREC("uid")=$$SETUID^HMPUTILS("doc-def",,IEN)
+10 SET INREC("abbreviation")=$GET(@Y@(.02,"E"))
+11 SET INREC("displayName")=$GET(@Y@(.03,"E"))
+12 SET INREC("typeName")=$GET(@Y@(.04,"E"))
+13 SET INREC("typeUid")=$$SETUID^HMPUTILS("doc-type",,$GET(@Y@(.04,"I")))
+14 SET X=$GET(@Y@(.05,"I"))
IF X
Begin DoDot:1
+15 SET INREC("ownerUid")=$$SETUID^HMPUTILS("user",,X)
+16 SET INREC("ownerName")=$GET(@Y@(.05,"E"))
End DoDot:1
+17 SET X=$GET(@Y@(.06,"I"))
if X
SET INREC("classOwner")=$$SETUID^HMPUTILS("asu-class",,X)
+18 SET X=$GET(@Y@(.07,"I"))
IF X
Begin DoDot:1
+19 SET INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X)
+20 SET INREC("statusName")=$GET(@Y@(.07,"E"))
End DoDot:1
+21 SET X=$GET(@Y@(.1,"I"))
if X
SET INREC("shared")="true"
+22 SET X=$GET(@Y@(.13,"I"))
if X
SET INREC("nationalStandard")="true"
+23 SET X=$GET(@Y@(.14,"I"))
if X
SET INREC("postingCode")=$$SETUID^HMPUTILS("doc-posting",,X)
+24 ;ICR 2700 DE2818 ASF 11/21/15
SET I=0
FOR
SET I=$ORDER(^TIU(8925.1,IEN,10,I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+25 SET INREC("item",I,"uid")=$$SETUID^HMPUTILS("doc-def",,X)
+26 SET INREC("item",I,"name")=$$GET1^DIQ(8925.1,X_",",.01)
End DoDot:1
+27 ; national title info
+28 ;National Title + attributes
SET X=$GET(@Y@(1501,"I"))
IF X
Begin DoDot:1
+29 NEW IENS,TIU,DA,FNUM,NAME
+30 SET IENS=X_","
DO GETS^DIQ(8926.1,IENS,"*","IE","TIU")
+31 SET INREC("nationalTitle","vuid")="urn:va:vuid:"_$GET(TIU(8926.1,IENS,99.99,"E"))
+32 SET INREC("nationalTitle","name")=$GET(TIU(8926.1,IENS,.01,"E"))
+33 FOR I=".04^Subject^2",".05^Role^3",".06^Setting^4",".07^Service^5",".08^Type^6"
Begin DoDot:2
+34 SET DA=+$GET(TIU(8926.1,IENS,+I,"I"))
if DA'>0
QUIT
+35 SET FNUM="8926."_+$PIECE(I,U,3)
SET NAME=$$LOW^XLFSTR($PIECE(I,U,2))
+36 SET INREC("nationalTitle"_$PIECE(I,U,2),"vuid")="urn:va:vuid:"_$$VUID^HMPD(DA,FNUM)
+37 SET INREC("nationalTitle"_$PIECE(I,U,2),"name")=$GET(TIU(8926.1,IENS,+I,"E"))
End DoDot:2
End DoDot:1
+38 ;
+39 DO ADD^HMPEF("INREC")
SET HMPLAST=IEN
+40 QUIT
