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

AQAOCHK0.m

Go to the documentation of this file. 
  1. AQAOCHK0 ; IHS/ORDC/LJF - CHECK OCC NEEDNG REVIEW SUBRTNS ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This rtn contains subrtns called by ^AQAOCHK.  These subrtns set
  1.  ;the appropriate array entries based on occurrence status.  These
  1.  ;arrays are used in the printing of the introductory message.
  1.  ;
  1. REFSET ;ENTRY POINT >> set referral data
  1.  S X=$S($P(AQAOREF,";",2)="AQAO(9,":2,1:3)
  1. REFSET1 ;ENTRY POINT >> SUBRTN REFSET but X already set
  1.  I $D(AQAOXYZ)#2 D QIREF ;set all referrals in qi staff
  1.  I X=2 Q:$P(AQAOREF,";")'=AQAODUZ  ;referred to another user
  1.  I X=3 Q:'$D(AQAOXYZ(1,$P(AQAOREF,";")))  ;referred to other team
  1.  D SET1 Q
  1.  ;
  1.  ;
  1. SET ;ENTRY POINT >> SUBRTN to set array variables
  1.  I '($D(AQAOXYZ)#2) Q:'$D(AQAOXYZ(2,AQAOIND))
  1. SET1 I (X=1)!(X=4) Q:'$$SRV  ;check affil srv for auto occ
  1.  S AQAOXYZ(3,X)=$G(AQAOXYZ(3,X))+1 ;increment count
  1.  I X=1 S AQAOSTR=AQAOIND_U_U_U_$$DATESTMP ;initial review data
  1.  I (X=2)!(X=3) S AQAOSTR=AQAOIND_U_$S(AQAOLST=0:$P(^AQAOC(+AQAOIFN,1),U,4),1:$P(^AQAOC(+AQAOIFN,"REV",AQAOLST,0),U,2))_U_AQAOREF_U_$$DATESTMP ;if referral, store indicator & referred by & date review entered
  1.  I X=4 S AQAOSTR=AQAOIND_U_$S(AQAOLST=0:$P(^AQAOC(+AQAOIFN,1),U,3)_U_$P(^(1),U,6),1:$P(^AQAOC(+AQAOIFN,"REV",AQAOLST,0),U)_U_$P(^(0),U,7)) ;for occ not closed,store indicator & review stage
  1.  S ^TMP("AQAOCHK",$J,X,AQAOIND,AQAODT,AQAOIFN)=AQAOSTR ;set occ 4 rprt
  1.  Q
  1.  ;
  1.  ;
  1. QIREF ;EP; >> SUBRTN to set all referrals in user is qi staff;PATCH 4
  1.  NEW AQAOX
  1.  S AQAOX=0
  1.  F  S AQAOX=$O(AQAOR1(AQAOX)) Q:'AQAOX  D
  1.  . I $P(AQAOR1(AQAOX),U)<+$G(AQAOR2(AQAOX)) Q
  1.  . S Y=$P(AQAOR1(AQAOX),U,2),(X,AQAOLST)=+Y,Y=$P(Y,",",2)
  1.  . S AQAOREF=$$SETREFRL(X,Y) Q:AQAOREF=""
  1.  . S X=$S(AQAOREF["AQAO(9,":2,1:3)
  1.  . S AQAOXYZ(3,X,1)=$G(AQAOXYZ(3,X,1))+1 ;increment count
  1.  . I $D(AQAOXYZ(1,$P(AQAOREF,";"))) S AQAOXYZ(3,X)=$G(AQAOXYZ(3,X))+1
  1.  . S AQAOSTR=AQAOIND_U_$S(AQAOLST=0:$P(^AQAOC(+AQAOIFN,1),U,4),1:$P(^AQAOC(+AQAOIFN,"REV",AQAOLST,0),U,2)) ;if referral, store indicator & referred by
  1.  . S AQAOSTR=AQAOSTR_U_AQAOREF_U_$$DATESTMP ;include referred to
  1.  . S ^TMP("AQAOCHK",$J,X,AQAOIND,AQAODT,AQAOIFN,AQAOLST,+Y)=AQAOSTR
  1.  Q
  1.  ;
  1. SETREFRL(X,Y) ;EP; -- SUBRTN to set referred to;PATCH 4
  1.  NEW Z S Z=""
  1.  I X=0,+Y=0 S Z=$P(^AQAOC(AQAOIFN,1),U,9)
  1.  I X=0,Y>0 S Z=$P(^AQAOC(AQAOIFN,"IADDRV",Y,0),U)
  1.  I X>0,+Y=0 S Z=$P(^AQAOC(AQAOIFN,"REV",X,0),U,9)
  1.  I X>0,Y>0 S Z=$P(^AQAOC(AQAOIFN,"REV",X,"ADDRV",Y,0),U)
  1.  Q Z
  1.  ;
  1. DATESTMP()         ;EXTRN VAR to find data occ or review entered
  1.  ;used to see if occ overdue for review
  1.  N AQAODT,AQAOU S AQAOU=0 Q:X>3
  1.  F  S AQAOU=$O(^AQAGU("AC",+AQAOIFN,AQAOU)) Q:AQAOU=""  Q:$D(AQAODT)  D
  1.  .I X=1 Q:$P($G(^AQAGU(AQAOU,0)),U,4)'="O"
  1.  .I X>1 Q:$P($G(^AQAGU(AQAOU,0)),U,4)'="E"
  1.  .I X>1,AQAOLST=0 Q:$P($G(^AQAGU(AQAOU,0)),U,5)'="INITIAL REVIEW"
  1.  .I X>1,AQAOLST>0 Q:$P($G(^AQAGU(AQAOU,0)),U,6)'=AQAOLST
  1.  .S AQAODT=$P($G(^AQAGU(AQAOU,0)),U) ;date/time stamp
  1.  Q $G(AQAODT)
  1.  ;
  1.  ;
  1. OVERDUE() ;ENTRY POINT for EXTRN VAR
  1.  ;to print * if occ overdue for review
  1.  ;called by AQAOCHK2
  1.  N AQAOP,X
  1.  S X1=DT,X2=$P(AQAOSTR,U,4) D ^%DTC
  1.  I X>$P(^AQAGP(DUZ(2),0),U,2) S AQAOP="*"
  1.  Q $G(AQAOP)
  1.  ;
  1.  ;
  1. SRV() ;EXTRN VAR to see if service screen is needed
  1.  N X,Y S Y=1,X=0
  1.  I $P(^AQAOC(AQAOIFN,0),U,11)=1,$P(^(0),U,7)]"",'($D(AQAOXYZ)#2) D
  1.  .F  S X=$O(AQAOXYZ(1,X)) Q:X=""  I $D(^AQAO(2,"AC",X,$P(^AQAOC(AQAOIFN,0),U,8))),$D(^AQAO1(1,"AB",$P(^AQAOC(AQAOIFN,0),U,7),X)) Q  ;PATCH 2
  1.  I X="" S Y=0 ;is auto occ and user not have access to team/srv combo
  1.  Q Y