Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPEASU

HMPEASU.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. CLASS ; -- USR Class file #8930
  1.  N PRV S PRV=+$G(HMPLAST)
  1.  S HMPCNT=$$TOTAL^HMPEF("^USR(8930)")
  1.  I PRV=0 S PRV=.9
  1.  I $L(HMPID) D CLS1(HMPID) Q
  1.  F  S PRV=$O(^USR(8930,PRV)) Q:PRV'>0  D CLS1(PRV) I HMPMAX,HMPI'<HMPMAX Q
  1.  I PRV'>0 S HMPFINI=1
  1.  Q
  1.  ;
  1. CLS1(IEN) ;
  1.  N $ES,$ET,ERRMSG
  1.  S ERRMSG=$$ERRMSG^HMPEF("User Class",IEN)
  1.  S $ET="D ERRHDLR^HMPDERRH"
  1.  N HMPV,FLDS,X,Y,INREC
  1.  K HMPV S FLDS=".01:.05;1*"
  1.  D GETS^DIQ(8930,IEN_",",FLDS,"IEN","HMPV")
  1.  S Y=$NA(HMPV(8930,IEN_","))
  1.  S INREC("name")=$G(@Y@(.01,"E"))
  1.  S INREC("localId")=IEN,INREC("uid")=$$SETUID^HMPUTILS("asu-class",,IEN)
  1.  S INREC("abbreviation")=$G(@Y@(.02,"E")),INREC("active")=$S($G(@Y@(.03,"I"))=1:"true",1:"false")
  1.  S INREC("displayName")=$G(@Y@(.04,"E"))
  1.  I $D(HMPV("8930.01")) D
  1.  . N IEN2,ID,CNT
  1.  . S IEN2="",CNT=0
  1.  . F  S IEN2=$O(HMPV(8930.01,IEN2)) Q:IEN2=""  D
  1.  . . S CNT=CNT+1,INREC("subClass",CNT,"name")=HMPV("8930.01",IEN2,".01","E")
  1.  . . S ID=HMPV(8930.01,IEN2,.01,"I"),INREC("subClass",CNT,"uid")=$$SETUID^HMPUTILS("asu-class",,ID)
  1.  D ADD^HMPEF("INREC") S HMPLAST=IEN
  1.  Q
  1.  ;
  1. RULE ; -- USR Authorization/Subscription file #8930.1
  1.  N PRV S PRV=+$G(HMPLAST)
  1.  S HMPCNT=$$TOTAL^HMPEF("^USR(8930.1)")
  1.  I PRV=0 S PRV=.9
  1.  I $L(HMPID) D RULE1(HMPID) Q
  1.  F  S PRV=$O(^USR(8930.1,PRV)) Q:PRV'>0  D RULE1(PRV) I HMPMAX,HMPI'<HMPMAX Q
  1.  I PRV'>0 S HMPFINI=1
  1.  Q
  1.  ;
  1. RULE1(IEN) ;
  1.  N $ES,$ET,ERRMSG
  1.  S ERRMSG=$$ERRMSG^HMPEF("ASU Rule",IEN)
  1.  S $ET="D ERRHDLR^HMPDERRH"
  1.  N HMPV,FLDS,X,Y,INREC,DESC
  1.  K HMPV S FLDS=".01:1"
  1.  D GETS^DIQ(8930.1,IEN_",",FLDS,"IEN","HMPV")
  1.  S Y=$NA(HMPV(8930.1,IEN_","))
  1.  S INREC("localId")=IEN,INREC("uid")=$$SETUID^HMPUTILS("asu-rule",,IEN)
  1.  S X=$G(@Y@(.01,"I")) S:X INREC("docDefUid")=$$SETUID^HMPUTILS("doc-def",,X),INREC("docDefName")=$G(@Y@(.01,"E"))
  1.  S X=$G(@Y@(.02,"I")) S:X INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X),INREC("statusName")=$G(@Y@(.02,"E"))
  1.  S X=$G(@Y@(.03,"I")) S:X INREC("actionUid")=$$SETUID^HMPUTILS("doc-action",,X),INREC("actionName")=$G(@Y@(.03,"E"))
  1.  S X=$G(@Y@(.04,"I")) S:X INREC("userClassUid")=$$SETUID^HMPUTILS("asu-class",,X),INREC("userClassName")=$G(@Y@(.04,"E"))
  1.  S X=$G(@Y@(.05,"I")),INREC("isAnd")=$S(X="&":"true",1:"false") ;,INREC("isOr")=$S(X="!":"true",1:"false")
  1.  S X=$G(@Y@(.06,"I")) S:X INREC("userRoleUid")=$$SETUID^HMPUTILS("asu-role",,X),INREC("userRoleName")=$G(@Y@(.06,"E"))
  1.  I $D(@Y@(1)) D
  1.  . N I S I=0 F  S I=$O(@Y@(1,I)) Q:I<1  S DESC(I)=@Y@(1,I)
  1.  . S INREC("description")=$$STRING^HMPD(.DESC)
  1.  D ADD^HMPEF("INREC") S HMPLAST=IEN
  1.  Q
  1.  ;
  1. DEF ; -- TIU Document Definition file #8925.1
  1.  N PRV S PRV=+$G(HMPLAST)
  1.  S HMPCNT=$$TOTAL^HMPEF("^TIU(8925.1)")
  1.  I PRV=0 S PRV=.9
  1.  I $L(HMPID) D DEF1(HMPID) Q
  1.  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
  1.  I PRV'>0 S HMPFINI=1
  1.  Q
  1.  ;
  1. DEF1(IEN) ;
  1.  N $ES,$ET,ERRMSG
  1.  S ERRMSG=$$ERRMSG^HMPEF("TIU Doc Def",IEN)
  1.  S $ET="D ERRHDLR^HMPDERRH"
  1.  N HMPV,FLDS,X,Y,I,INREC
  1.  K HMPV S FLDS=".01:.14;1501"
  1.  D GETS^DIQ(8925.1,IEN_",",FLDS,"IEN","HMPV")
  1.  S Y=$NA(HMPV(8925.1,IEN_","))
  1.  S INREC("name")=$G(@Y@(.01,"E"))
  1.  S INREC("uid")=$$SETUID^HMPUTILS("doc-def",,IEN)
  1.  S INREC("abbreviation")=$G(@Y@(.02,"E"))
  1.  S INREC("displayName")=$G(@Y@(.03,"E"))
  1.  S INREC("typeName")=$G(@Y@(.04,"E"))
  1.  S INREC("typeUid")=$$SETUID^HMPUTILS("doc-type",,$G(@Y@(.04,"I")))
  1.  S X=$G(@Y@(.05,"I")) I X D
  1.  . S INREC("ownerUid")=$$SETUID^HMPUTILS("user",,X)
  1.  . S INREC("ownerName")=$G(@Y@(.05,"E"))
  1.  S X=$G(@Y@(.06,"I")) S:X INREC("classOwner")=$$SETUID^HMPUTILS("asu-class",,X)
  1.  S X=$G(@Y@(.07,"I")) I X D
  1.  . S INREC("statusUid")=$$SETUID^HMPUTILS("doc-status",,X)
  1.  . S INREC("statusName")=$G(@Y@(.07,"E"))
  1.  S X=$G(@Y@(.1,"I")) S:X INREC("shared")="true"
  1.  S X=$G(@Y@(.13,"I")) S:X INREC("nationalStandard")="true"
  1.  S X=$G(@Y@(.14,"I")) S:X INREC("postingCode")=$$SETUID^HMPUTILS("doc-posting",,X)
  1.  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
  1.  . S INREC("item",I,"uid")=$$SETUID^HMPUTILS("doc-def",,X)
  1.  . S INREC("item",I,"name")=$$GET1^DIQ(8925.1,X_",",.01)
  1.  ; national title info
  1.  S X=$G(@Y@(1501,"I")) I X D  ;National Title + attributes
  1.  . N IENS,TIU,DA,FNUM,NAME
  1.  . S IENS=X_"," D GETS^DIQ(8926.1,IENS,"*","IE","TIU")
  1.  . S INREC("nationalTitle","vuid")="urn:va:vuid:"_$G(TIU(8926.1,IENS,99.99,"E"))
  1.  . S INREC("nationalTitle","name")=$G(TIU(8926.1,IENS,.01,"E"))
  1.  . F I=".04^Subject^2",".05^Role^3",".06^Setting^4",".07^Service^5",".08^Type^6" D
  1.  .. S DA=+$G(TIU(8926.1,IENS,+I,"I")) Q:DA'>0
  1.  .. S FNUM="8926."_+$P(I,U,3),NAME=$$LOW^XLFSTR($P(I,U,2))
  1.  .. S INREC("nationalTitle"_$P(I,U,2),"vuid")="urn:va:vuid:"_$$VUID^HMPD(DA,FNUM)
  1.  .. S INREC("nationalTitle"_$P(I,U,2),"name")=$G(TIU(8926.1,IENS,+I,"E"))
  1.  ;
  1.  D ADD^HMPEF("INREC") S HMPLAST=IEN
  1.  Q