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

ORACCES2.m

Go to the documentation of this file.
  1. ORACCES2 ;SLC/JNM - User Read/Write Access to CPRS ; Jan 05, 2024@12:47
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**588,608**;Dec 17, 1997;Build 15;
  1. ; Reference to ^XTV(8989.5,"AC" in ICR #2686
  1. Q
  1. ;
  1. ACCESS(RESULTS,USER,GETNOTES,NOTES) ;
  1. ; NOTES only populated if GETNOTES>0
  1. ; GETNOTES=1 Adds just the missing dependencies
  1. ; GETNOTES=2 Adds the entire description
  1. N CNT,CNT2,IEN,IENARR,NODE,ORERR,ORVALUE,TAB,VALUE,X,SORT,COUNT,PARAM,LASTPARAM,SHOW
  1. N ORPARAM,ORTABS,CPRS,WRITE,TEMPLATE,DG,TABS,OTHER,ORDERS,ERROR,NCNT,MAXGROUPS,SHOWEXCLUDE
  1. N ORDERSTAB,ALLERGIESTAB,NOTESTAB,DELAYEDORDERSTAB,IMMUNIZATIONSTAB,ENCOUNTERSTAB
  1. D GETPARAMS^ORACCESS
  1. S CPRS="cprsAccess",WRITE="writeAccess",TEMPLATE="templateAccess",DG="displayGroups"
  1. S SORT="SORT",MAXGROUPS=0
  1. S ORDERSTAB=$$TABIDX^ORACCESS(TABS,"O"),ALLERGIESTAB=$$TABIDX^ORACCESS(OTHER,"A")
  1. S NOTESTAB=$$TABIDX^ORACCESS(TABS,"N"),DELAYEDORDERSTAB=$$TABIDX^ORACCESS(OTHER,"D")
  1. S IMMUNIZATIONSTAB=$$TABIDX^ORACCESS(OTHER,"I"),ENCOUNTERSTAB=$$TABIDX^ORACCESS(OTHER,"E")
  1. S GETNOTES=+$G(GETNOTES) K NOTES
  1. S RESULTS(CPRS,"errorMessage")=$$GET^XPAR("ALL",ORPARAM(ERROR))
  1. ;get tabs values
  1. S TAB=0 F S TAB=$O(ORTABS(TAB)) Q:'TAB D
  1. .S VALUE=$$GET^XPAR("ALL",ORPARAM(ORTABS(TAB,1)),ORTABS(TAB,2))
  1. .I VALUE="" S VALUE=0
  1. .S RESULTS(CPRS,ORTABS(TAB,3),WRITE)=VALUE
  1. .I ORTABS(TAB,5)=1 S RESULTS(CPRS,ORTABS(TAB,3),TEMPLATE)=VALUE
  1. .I GETNOTES=2,TAB'=ORDERSTAB,TAB'=DELAYEDORDERSTAB D
  1. ..S NOTES(SORT,ORTABS(TAB,1)_$$TABDESC^ORACCESS(TAB,1))=VALUE
  1. ;get Order Display Groups Write Access
  1. I RESULTS(CPRS,ORTABS(ORDERSTAB,3),WRITE)=1 D
  1. .S (CNT,CNT2)=0
  1. .F X="PKG","SYS","DIV","USR" D
  1. ..K ORVALUE,ORERR
  1. ..D GETLST^XPAR(.ORVALUE,X,ORPARAM(ORDERS),"I",.ORERR)
  1. ..S IEN=0 F S IEN=$O(ORVALUE(IEN)) Q:IEN'>0 D
  1. ...S VALUE=ORVALUE(IEN)
  1. ...S NODE=$G(^ORD(100.98,IEN,0)) I NODE="" Q
  1. ...I X="PKG" D Q
  1. ....S CNT=CNT+1,CNT2=CNT
  1. ....S IENARR(IEN)=VALUE_U_CNT
  1. ....D ADDGROUPRESULTS
  1. ...I $D(IENARR(IEN)),+IENARR(IEN)=VALUE Q
  1. ...I $D(IENARR(IEN)) S $P(IENARR(IEN),U,1)=VALUE,CNT=$P(IENARR(IEN),U,2)
  1. ...E S CNT2=CNT2+1,CNT=CNT2,IENARR(IEN)=VALUE_U_CNT
  1. ...D ADDGROUPRESULTS
  1. .; Add any missing groups
  1. .S VALUE=1,IEN=0 F S IEN=$O(^ORD(100.98,IEN)) Q:'IEN D
  1. ..S NODE=$G(^ORD(100.98,IEN,0)),MAXGROUPS=MAXGROUPS+1 I '$D(IENARR(IEN)) D
  1. ...S CNT2=CNT2+1,CNT=CNT2,IENARR(IEN)=VALUE_U_CNT
  1. ...D ADDGROUPRESULTS
  1. .I GETNOTES=2 D
  1. ..F X=1:1:CNT2 D
  1. ...S NOTES(SORT,3_RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,X,"name"))=RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,X,WRITE)
  1. ;
  1. I RESULTS(CPRS,ORTABS(ALLERGIESTAB,3),WRITE)=1 D
  1. .N MSG
  1. .I RESULTS(CPRS,ORTABS(NOTESTAB,3),WRITE)=0 S MSG=ORTABS(NOTESTAB,4)_" tab"
  1. .I RESULTS(CPRS,ORTABS(ORDERSTAB,3),WRITE)=0 D I 1
  1. ..I $D(MSG) S MSG=MSG_" and "
  1. ..S MSG=$G(MSG)_ORTABS(ORDERSTAB,4)_" tab"
  1. .E D
  1. ..S IEN=$O(^ORD(100.98,"B","ALLERGIES",0))
  1. ..I IEN,$D(IENARR(IEN)),$P(IENARR(IEN),U)=0 D
  1. ...I $D(MSG) S MSG=MSG_" and "
  1. ...S MSG=$G(MSG)_"ALLERGIES display group"
  1. .I $D(MSG) D
  1. ..S RESULTS(CPRS,ORTABS(ALLERGIESTAB,3),WRITE)=0
  1. ..I GETNOTES>0 S NOTES(SORT,4_ORTABS(ALLERGIESTAB,4)_" requires "_MSG_" access")=1
  1. ..I GETNOTES=2 S NOTES(SORT,ORTABS(ALLERGIESTAB,1)_$$TABDESC^ORACCESS(ALLERGIESTAB,1))=0
  1. ;
  1. I RESULTS(CPRS,ORTABS(DELAYEDORDERSTAB,3),WRITE)=1,RESULTS(CPRS,ORTABS(ORDERSTAB,3),WRITE)=0 D
  1. .S RESULTS(CPRS,ORTABS(DELAYEDORDERSTAB,3),WRITE)=0
  1. .I GETNOTES>0 S NOTES(SORT,4_ORTABS(DELAYEDORDERSTAB,4)_" requires "_ORTABS(ORDERSTAB,4)_" tab access")=1
  1. .;I GETNOTES=2 S NOTES(SORT,ORTABS(DELAYEDORDERSTAB,1)_$$TABDESC^ORACCESS(DELAYEDORDERSTAB,1))=0
  1. ;
  1. I RESULTS(CPRS,ORTABS(IMMUNIZATIONSTAB,3),WRITE)=1 D
  1. .N MSG
  1. .I RESULTS(CPRS,ORTABS(NOTESTAB,3),WRITE)=0 S MSG=ORTABS(NOTESTAB,4)_" tab"
  1. .I RESULTS(CPRS,ORTABS(ENCOUNTERSTAB,3),WRITE)=0 D
  1. ..I $D(MSG) S MSG=MSG_" and "
  1. ..S MSG=$G(MSG)_ORTABS(ENCOUNTERSTAB,4)
  1. .I $D(MSG) D
  1. ..S RESULTS(CPRS,ORTABS(IMMUNIZATIONSTAB,3),WRITE)=0
  1. ..I GETNOTES>0 S NOTES(SORT,4_ORTABS(IMMUNIZATIONSTAB,4)_" requires "_MSG_" access")=1
  1. ..I GETNOTES=2 S NOTES(SORT,ORTABS(IMMUNIZATIONSTAB,1)_$$TABDESC^ORACCESS(IMMUNIZATIONSTAB,1))=0
  1. ;
  1. I GETNOTES>0 D
  1. .N MSG S SHOWEXCLUDE=0
  1. .I GETNOTES=2,RESULTS(CPRS,ORTABS(ORDERSTAB,3),WRITE)=1 D
  1. ..S MSG=ORTABS(ORDERSTAB,1)_$$TABDESC^ORACCESS(ORDERSTAB,1)_", delayed orders "
  1. ..I RESULTS(CPRS,ORTABS(DELAYEDORDERSTAB,3),WRITE)=0 S MSG=MSG_"not "
  1. ..S MSG=MSG_"allowed",NOTES(SORT,MSG)=1
  1. .S (NCNT,LASTPARAM)=0 F PARAM=1:1:4 S COUNT(PARAM)=0
  1. .S NODE="" F S NODE=$O(NOTES(SORT,NODE)) Q:NODE="" D
  1. ..S PARAM=+$E(NODE,1,1) I +NOTES(SORT,NODE) S COUNT(PARAM)=COUNT(PARAM)+1
  1. .S NODE="" F S NODE=$O(NOTES(SORT,NODE)) Q:NODE="" D
  1. ..S PARAM=+$E(NODE,1,1)
  1. ..I PARAM'=LASTPARAM D
  1. ...N IDX,MSGOUT S MSG=""
  1. ...S LASTPARAM=PARAM
  1. ...I NCNT>0 S NCNT=NCNT+1,NOTES(NCNT)=""
  1. ...I COUNT(PARAM)=0 D I 1
  1. ....I PARAM<3 D
  1. .....N MSGSORT,CNT,MAX S (IDX,CNT,MAX)=0
  1. .....F S IDX=$O(ORTABS(IDX)) Q:'IDX I IDX'=DELAYEDORDERSTAB,ORTABS(IDX,1)=PARAM S MAX=MAX+1
  1. .....S IDX=0 F S IDX=$O(ORTABS(IDX)) Q:'IDX I IDX'=DELAYEDORDERSTAB,ORTABS(IDX,1)=PARAM D
  1. ......S MSGSORT($$TABDESC^ORACCESS(IDX,$S(ORTABS(IDX,5)=2:1,1:0)))=""
  1. .....S IDX="" F S IDX=$O(MSGSORT(IDX)) Q:IDX="" D
  1. ......S CNT=CNT+1 I MSG'="" S MSG=MSG_$S(CNT<MAX:", ",1:" or ")
  1. ......S MSG=MSG_IDX
  1. .....I PARAM=1 S MSG=MSG_" tabs"
  1. ....I PARAM=3 S MSG="any display groups"
  1. ....S MSG="No write access for "_MSG_"."
  1. ....D WRAP^ORUTL(MSG,"MSGOUT",1,0,3,0,78)
  1. ....S IDX=0 F S IDX=$O(MSGOUT(IDX)) Q:'IDX D
  1. .....S NCNT=NCNT+1,NOTES(NCNT)=MSGOUT(IDX)
  1. ...E D ; COUNT(PARAM)>0
  1. ....S NCNT=NCNT+1
  1. ....I PARAM=1 S NOTES(NCNT)="Write access allowed for the following tab"_$S(COUNT(PARAM)>1:"s",1:"")_":"
  1. ....I PARAM=2 S NOTES(NCNT)="Write access allowed for the following additional functionality:"
  1. ....I PARAM=3 D
  1. .....S SHOWEXCLUDE=(COUNT(PARAM)<MAXGROUPS)&(COUNT(PARAM)>(MAXGROUPS/2))
  1. .....I COUNT(PARAM)<MAXGROUPS D
  1. ......I SHOWEXCLUDE S NOTES(NCNT)="Ordering write access allowed for all display groups EXCEPT:"
  1. ......E S NOTES(NCNT)="Ordering write access allowed for the following display group"_$S(COUNT(PARAM)>1:"s",1:"")_":"
  1. .....E S NOTES(NCNT)="Ordering write access allowed for all display groups."
  1. ....I PARAM=4 S NOTES(NCNT)="Missing write access dependenc"_$S(COUNT(PARAM)=1:"y",1:"ies")_":"
  1. ..S SHOW=(NOTES(SORT,NODE)>0) I PARAM=3,SHOWEXCLUDE S SHOW='SHOW
  1. ..I SHOW,(PARAM'=3)!(COUNT(PARAM)<MAXGROUPS) D
  1. ...S NCNT=NCNT+1,NOTES(NCNT)=" "_$E(NODE,2,999)
  1. .K NOTES(SORT)
  1. Q
  1. ;
  1. ADDGROUPRESULTS ;
  1. S RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,CNT,"ien")=IEN
  1. S RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,CNT,"name")=$P(NODE,U)
  1. S RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,CNT,"shortName")=$P(NODE,U,3)
  1. S RESULTS(CPRS,ORTABS(ORDERSTAB,3),DG,CNT,WRITE)=VALUE
  1. Q
  1. ;
  1. VALUEMSG(ENT,INST,X,GETALL,MESSAGE,NAME) ;
  1. I +$G(NODEPENDENCIES) Q
  1. S GETALL=+$G(GETALL)
  1. I $G(ENT)="" Q
  1. I 'GETALL,$G(X)'="YES" Q
  1. I $P($G(DIR(0)),U,3)'="" Q
  1. N CODE
  1. S CODE=$P($G(INST),U)
  1. I 'GETALL,"^A^D^I^"'[(U_CODE_U) Q
  1. N ORPARAM,ORPIEN,ORTABS,TABS,OTHER,ORDERS,ERROR,IEN,MCNT
  1. N ORDERSTAB,ALLERGIESTAB,NOTESTAB,DELAYEDORDERSTAB,IMMUNIZATIONSTAB,ENCOUNTERSTAB
  1. D GETPARAMS^ORACCESS(1)
  1. S MCNT=0
  1. S ORDERSTAB=$$TABIDX^ORACCESS(TABS,"O"),ALLERGIESTAB=$$TABIDX^ORACCESS(OTHER,"A")
  1. S NOTESTAB=$$TABIDX^ORACCESS(TABS,"N"),DELAYEDORDERSTAB=$$TABIDX^ORACCESS(OTHER,"D")
  1. S IMMUNIZATIONSTAB=$$TABIDX^ORACCESS(OTHER,"I"),ENCOUNTERSTAB=$$TABIDX^ORACCESS(OTHER,"E")
  1. I GETALL S CODE=$S(+$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(ALLERGIESTAB,1)),ENT,ORTABS(ALLERGIESTAB,2))):"A",1:"")
  1. I CODE="A" D
  1. .N MSG
  1. .I +$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(NOTESTAB,1)),ENT,ORTABS(NOTESTAB,2)))=0 D
  1. ..S MSG=ORTABS(NOTESTAB,4)_" tab"
  1. .I +$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(ORDERSTAB,1)),ENT,ORTABS(ORDERSTAB,2)))=0 D I 1
  1. ..I $D(MSG) S MSG=MSG_" and "
  1. ..S MSG=$G(MSG)_ORTABS(ORDERSTAB,4)_" tab"
  1. .E D
  1. ..S IEN=$O(^ORD(100.98,"B","ALLERGIES",0))
  1. ..I IEN,+$G(^XTV(8989.5,"AC",ORPIEN(ORDERS),ENT,IEN))=0 D
  1. ...I $D(MSG) S MSG=MSG_" and "
  1. ...S MSG=$G(MSG)_"ALLERGIES display group"
  1. .I $D(MSG) D
  1. ..S MCNT=MCNT+1,MESSAGE(MCNT)=" "_ORTABS(ALLERGIESTAB,4)_" also requires "_MSG_" access."
  1. I GETALL S CODE=$S(+$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(DELAYEDORDERSTAB,1)),ENT,ORTABS(DELAYEDORDERSTAB,2))):"D",1:"")
  1. I CODE="D" D
  1. .I +$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(ORDERSTAB,1)),ENT,ORTABS(ORDERSTAB,2)))=0 D
  1. ..S MCNT=MCNT+1,MESSAGE(MCNT)=" "_ORTABS(DELAYEDORDERSTAB,4)_" also requires "_ORTABS(ORDERSTAB,4)_" tab access."
  1. I GETALL S CODE=$S(+$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(IMMUNIZATIONSTAB,1)),ENT,ORTABS(IMMUNIZATIONSTAB,2))):"I",1:"")
  1. I CODE="I" D
  1. .N MSG
  1. .I +$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(NOTESTAB,1)),ENT,ORTABS(NOTESTAB,2)))=0 D
  1. ..S MSG=ORTABS(NOTESTAB,4)_" tab"
  1. .I +$G(^XTV(8989.5,"AC",ORPIEN(ORTABS(ENCOUNTERSTAB,1)),ENT,ORTABS(ENCOUNTERSTAB,2)))=0 D
  1. ..I $D(MSG) S MSG=MSG_" and "
  1. ..S MSG=$G(MSG)_ORTABS(ENCOUNTERSTAB,4)
  1. .I $D(MSG) D
  1. ..S MCNT=MCNT+1,MESSAGE(MCNT)=" "_ORTABS(IMMUNIZATIONSTAB,4)_" also requires "_MSG_" access."
  1. I MCNT>0 D
  1. .I GETALL D
  1. ..S MESSAGE(0.5)="Missing write access dependenc"_$S(MCNT=1:"y",1:"ies")_"* for "_$G(NAME)
  1. ..S MESSAGE(999)="* Dependencies may be resolved at a different level."
  1. .I 'GETALL S IEN=0 F S IEN=$O(MESSAGE(IEN)) Q:'IEN W !,MESSAGE(IEN)
  1. Q
  1. ;
  1. DLGOIINFO(ORY,LIST,INFO) ; Return orderable item info tied to each order dialog in the list
  1. ; INFO=1 Get LAB SECTION
  1. I '+$G(INFO) Q
  1. N IDX,DLG,OI,OIIDX,SUBIDX,CODE,LINE
  1. S OIIDX=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)) I 'OIIDX Q
  1. S (LINE,IDX)=0 F S IDX=$O(LIST(IDX)) Q:'IDX D
  1. . S (OI,SUBIDX)=0 F S SUBIDX=$O(^ORD(101.41,LIST(IDX),6,SUBIDX)) Q:'SUBIDX D Q:OI
  1. . . I $P($G(^ORD(101.41,LIST(IDX),6,SUBIDX,0)),U,2)=OIIDX D Q
  1. . . . S OI=$P($G(^ORD(101.41,LIST(IDX),6,SUBIDX,1)),U,1)
  1. . I OI D
  1. . . S CODE=""
  1. . . I INFO=1 S CODE=$P($G(^ORD(101.43,OI,"LR")),U,6) I CODE="" S CODE="CH"
  1. . . I CODE'="" S LINE=LINE+1,ORY(LINE)=LIST(IDX)_U_CODE
  1. Q
  1. ;
  1. LABSBYXREF(ORY,DGSNAME) ; Return all LAB SECTION codes used by the specified XREF
  1. S ORY=U
  1. N XREF S XREF="S."_DGSNAME
  1. I "^S.LAB^S.AP^"'[(U_$G(XREF)_U) Q
  1. N DG,I,CODE,NAME,TEMP,LST,ILST,LIST,OUTPUT,ISAP,QUIT,APDLGIEN,X,CURTM
  1. S CURTM=$$NOW^XLFDT,ISAP=(XREF="S.AP")
  1. S NAME="" F S NAME=$O(^ORD(101.43,XREF,NAME)) Q:NAME="" D
  1. . S I=0 F S I=$O(^ORD(101.43,XREF,NAME,I)) Q:'I D
  1. . . S X=$G(^ORD(101.43,XREF,NAME,I))
  1. . . I +$P(X,U,3),$P(X,U,3)<CURTM Q
  1. . . I $P(X,U,5) Q
  1. . . I ISAP D Q:QUIT
  1. . . . S QUIT=1
  1. . . . I '$$OK4CPRS^ORWLRAP1(I) Q
  1. . . . S APDLGIEN=+$O(^ORD(101.45,"C",I,0)) I 'APDLGIEN Q
  1. . . . I +$P($G(^ORD(101.45,APDLGIEN,0)),U,6) Q
  1. . . . S QUIT=0
  1. . . S CODE=$P($G(^ORD(101.43,I,"LR")),U,6)
  1. . . I CODE="" S CODE="CH"
  1. . . I '$D(TEMP(CODE)) S TEMP(CODE)=""
  1. S ILST=0
  1. I XREF="S.LAB" D SHORT^ORWDLR32 ; Also get any codes used by quick orders
  1. I $D(LST) D
  1. . S I=0 F S I=$O(LST(I)) Q:'I S LST(I)=$E($P(LST(I),U,1),3,999)
  1. . D DLGOIINFO(.LIST,.LST,1)
  1. . S I=0 F S I=$O(LIST(I)) Q:'I D
  1. . . S CODE=$P(LIST(I),U,2) I CODE'="" S TEMP(CODE)=""
  1. S I="" F S I=$O(TEMP(I)) Q:I="" S ORY=ORY_I_U
  1. Q
  1. ;
  1. DIETINFO(ORY) ; Return Diet Order Dialog info used to write access
  1. N CNT,DIET,IEN,DG,TYPE,NAME
  1. S CNT=0
  1. D ADD2ORY("DIETETICS")
  1. S DIET=$O(^ORD(100.98,"B","DIETETICS",0)) Q:'DIET
  1. S IEN=0 F S IEN=$O(^ORD(100.98,DIET,1,IEN)) Q:'IEN D
  1. . S DG=$P($G(^ORD(100.98,DIET,1,IEN,0)),U) Q:'+DG
  1. . S TYPE="" D FINDTYP^ORWDFH(.TYPE,DG) I $G(TYPE)="" Q
  1. . S NAME=$P($G(^ORD(100.98,DG,0)),U,3) Q:NAME="D CON"
  1. . D ADD2ORY(DG_U_TYPE_U_$P($G(^ORD(100.98,DG,0)),U,3))
  1. Q
  1. ;
  1. ADD2ORY(TEXT) ;
  1. S CNT=CNT+1,ORY(CNT)=TEXT
  1. Q