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

AQAOSEC.m

Go to the documentation of this file. 
  1. AQAOSEC ; IHS/ORDC/LJF - SECURITY CHECK UTILITY ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;One of the most important routines in the package. Handles extra
  1.  ;security levels needed for such sensitive data.  Contains various
  1.  ;entry points called by entry actions & screens on DIC calls.
  1.  ;
  1.  Q
  1. ENTRY ;EP; used by options to check AQAOPT variable
  1.  ;called by entry actions; sets xquit if access not correct
  1.  ;
  1.  K AQAOCHK("VAR")
  1.  I '$D(AQAOUA("USER")) D  D CHECK Q
  1.  .S AQAOCHK("VAR")="***USER QI ACCESS INFO MISSING***"
  1.  I $P(AQAOUA("USER"),U,6)="",'$D(AQAOUA("USER","ACCESS")) D  D CHECK Q
  1.  .S AQAOCHK("VAR")="***USER QI ACCESS INFO MISSING***"
  1.  D ACCESS
  1.  ;
  1.  ; >> quit option if check variable set
  1. CHECK I $D(AQAOCHK("VAR")) W *7,!!,AQAOCHK("VAR") K AQAOCHK("VAR") S XQUIT=""
  1.  Q
  1.  ;
  1. ACCESS ; >>> SUBRTN to check user's access level
  1.  I '$D(AQAOCHK("ACTION")) S AQAOCHK("VAR")="***NO ACTION LEVEL SET***" Q
  1.  I AQAOCHK("ACTION")="INQUIRY" Q
  1.  I $P(AQAOUA("USER"),U,6)="QA" Q  ;pkg admin access
  1.  I (AQAOCHK("ACTION")="ADMIN") D  Q
  1.  .S AQAOCHK("VAR")="** YOU ARE NOT A DESIGNATED PACKAGE ADMINISTRATOR!"
  1.  I $P(AQAOUA("USER"),U,6)="QI" Q  ;qi staff
  1.  I AQAOCHK("ACTION")="EDIT" Q  ;PATCH 4
  1.  ;I AQAOCHK("ACTION")="EDIT" D  Q  ;PATCH 4
  1.  ;.S:(AQAOUA("USER","ACCESS")="1") AQAOCHK("VAR")="***YOU DO NOT HAVE ACCESS TO EDIT QI DATA, SEE YOUR SUPERVISOR***" ;PATCH 4
  1.  S AQAOCHK("VAR")="***ACTION LEVEL NOT SET CORRECTLY***"
  1.  Q
  1.  ;
  1.  ;
  1. INDCHK ;EP; called by DIC("S") to screen indicators
  1.  N AQAOI K AQAOCHK("OK") Q:'$D(AQAOUA("USER"))
  1.  I $P(AQAOUA("USER"),U,6)["Q" S AQAOCHK("OK")="" D RESETI Q  ;qi staff
  1.  I $O(^AQAO(2,Y,"QTM",0))="" S AQAOCHK("OK")="" D RESETI Q  ;open indtr
  1.  ;
  1.  S AQAOI=0 ;loop thru qi teams for indicator
  1.  F  S AQAOI=$O(^AQAO(2,Y,"QTM",AQAOI)) Q:AQAOI'=+AQAOI  D
  1.  .Q:'$D(^AQAO(2,Y,"QTM",AQAOI,0))  S AQAOIII=$P(^(0),U) ;team ifn
  1.  .I $D(AQAOUA("USER",AQAOIII)) D TEAMCHK ;check user's access level
  1.  ;
  1. RESETI K AQAOI,AQAOIII I ^AQAO(2,Y,0) ;reset naked ref
  1.  Q
  1.  ;
  1.  ;
  1. OCCCHK ;EP; called by DIC("S") to screen occurrence
  1.  K AQAOCHK("OK") Q:'$D(AQAOUA("USER"))
  1.  I $P(^AQAOC(Y,0),U,9)'=DUZ(2) D RESETO Q  ;another facility
  1.  I $P(AQAOUA("USER"),U,6)["Q" S AQAOCHK("OK")="" D RESETO Q  ;qi staff
  1.  ;
  1.  S AQAOI=$P(^AQAOC(Y,0),U,8) ;indicator
  1.  I '$O(^AQAO(2,AQAOI,"QTM",0)) S AQAOCHK("OK")="" D RESETO Q  ;open ind
  1.  ;
  1.  S AQAOII=0 ;check access via qi team
  1.  F  S AQAOII=$O(^AQAO(2,AQAOI,"QTM",AQAOII)) Q:AQAOII'=+AQAOII  D
  1.  .Q:'$D(^AQAO(2,AQAOI,"QTM",AQAOII,0))  S AQAOIII=$P(^(0),U)
  1.  .I $D(AQAOUA("USER",AQAOIII)) D
  1.  ..I +$O(^AQAO1(1,AQAOIII,1,0)),$P(^(0),U,7)]"" Q:'$D(^AQAO1(1,"AB",$P(^AQAOC(Y,0),U,7),AQAOIII))  ;service specific occ
  1.  ..D TEAMCHK ;check user access level
  1.  I $D(AQAOCHK("OK"))!('$D(AQAORVW)) D RESETO Q
  1.  ;
  1.  ;check for referrals
  1.  I $$INITIAL S AQAOCHK("OK")="" D RESETO Q  ;on initial review
  1.  I $$REVW S AQAOCHK("OK")="" ;on other reviews
  1.  ;
  1. RESETO K AQAOI,AQAOII,AQAOIII I ^AQAOC(Y,0) ;reset naked ref
  1.  Q
  1.  ;
  1. INITIAL() ;EXTRN VAR to see if occ was referred on initial review
  1.  N AQAOI,X S X=0,AQAOI=$P($G(^AQAOC(Y,1)),U,9)
  1.  I AQAOI]"" D
  1.  .I AQAOI["AQAO(9" S:(+AQAOI=DUZ) X=1
  1.  .I AQAOI["AQAO1(1" S:$D(AQAOUA("USER",+AQAOI)) X=1
  1.  .I X=0 S X=$$IADDRV ;check additional ref
  1.  Q X
  1.  ;
  1. IADDRV() ;EXTRN VAR to see if any additional referrals made on initial review
  1.  N AQAOI,AQAOII,X S X=0
  1.  S AQAOI=0
  1.  F  S AQAOI=$O(^AQAOC(Y,"IADDRV",AQAOI)) Q:AQAOI'=+AQAOI  Q:X=1  D
  1.  .Q:'$D(^AQAOC(Y,"IADDRV",AQAOI,0))  S AQAOII=$P(^(0),U)
  1.  .Q:AQAOII=""  I AQAOII["AQAO(9" S:+AQAOII=DUZ X=1
  1.  .I AQAOII["AQAO1(1" S:$D(AQAOUA("USER",+AQAOII)) X=1
  1.  Q X
  1.  ;
  1. REVW() ;EXTRN VAR to see if occ referred during other reviews
  1.  N AQAOI,AQAOII,X S X=0
  1.  S AQAOI=0
  1.  F  S AQAOI=$O(^AQAOC(Y,"REV",AQAOI)) Q:AQAOI'=+AQAOI  Q:X=1  D
  1.  .Q:'$D(^AQAOC(Y,"REV",AQAOI,0))  S AQAOII=$P(^(0),U,9) ;PATCH 4
  1.  .Q:AQAOII=""  I AQAOII["AQAO(9" S:+AQAOII=DUZ X=1
  1.  .I AQAOII["AQAO1(1" S:$D(AQAOUA("USER",+AQAOII)) X=1
  1.  .I X=0 S X=$$ADDRV(AQAOI) ;additional referrals
  1.  Q X
  1.  ;
  1. ADDRV(AQAOI) ;EXTRN VAR to see if additional ref made on other reviews
  1.  N AQAOIII,AQAOII,X S X=0
  1.  S AQAOII=0
  1.  F  S AQAOII=$O(^AQAOC(Y,"REV",AQAOI,"ADDRV",AQAOII)) Q:AQAOII'=+AQAOII  Q:X=1  D
  1.  .Q:'$D(^AQAOC(Y,"REV",AQAOI,"ADDRV",AQAOII,0))  S AQAOIII=$P(^(0),U)
  1.  .Q:AQAOIII=""  I AQAOIII["AQAO(9" S:+AQAOIII=DUZ X=1
  1.  .I AQAOIII["AQAO1(1" S:$D(AQAOUA("USER",+AQAOIII)) X=1
  1.  Q X
  1.  ;
  1.  ;
  1. ACTCHK ;EP; called by DIC("S") to screen actions
  1.  K AQAOCHK("OK") Q:'$D(AQAOUA("USER"))
  1.  I $P(^AQAO(5,Y,0),U,12)'=DUZ(2) D RESETA Q  ;another facility
  1.  I $P(AQAOUA("USER"),U,6)["Q" S AQAOCHK("OK")="" D RESETA Q  ;qi staff
  1.  ;
  1.  S AQAOI=$P(^AQAO(5,Y,0),U,14) ;indicator
  1.  I '$O(^AQAO(2,AQAOI,"QTM",0)) S AQAOCHK("OK")="" D RESETA Q  ;open ind
  1.  ;
  1.  S AQAOII=0 ;check access via qi team
  1.  F  S AQAOII=$O(^AQAO(2,AQAOI,"QTM",AQAOII)) Q:AQAOII'=+AQAOII  D
  1.  .Q:'$D(^AQAO(2,AQAOI,"QTM",AQAOII,0))  S AQAOIII=$P(^(0),U)
  1.  .I $D(AQAOUA("USER",AQAOIII)) D TEAMCHK ;check user access level
  1.  ;
  1. RESETA K AQAOI,AQAOII,AQAOIII I ^AQAO(5,Y,0) ;reset naked ref
  1.  Q
  1.  ;
  1. TEAMCHK ; >> SUBRTN called by INDCHK and OCCCHK
  1.  ;checks access level by team
  1.  I AQAOUA("USER",AQAOIII)="1",(AQAOCHK("ACTION")="INQUIRY") S AQAOCHK("OK")="" Q
  1.  I AQAOUA("USER",AQAOIII)="2" S AQAOCHK("OK")="" Q
  1.  Q