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

AGEDERR4.m

Go to the documentation of this file. 
  1. AGEDERR4 ; VNGT/HS/BEE - EDIT CHECK CALLS ; MAR 19, 2010 
  1.  ;;7.1;PATIENT REGISTRATION;**8,9,11**;AUG 25, 2005;Build 1
  1.  ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
  1.  Q
  1.  ;EDIT CHK #44 - AOB MISSING
  1.  ;ERROR VERSION (SEE EDIT CHK #1 FOR WARNING VERSION)
  1. AOBMISS(DFN) ;EP
  1.   ;
  1.  ;Quit if AOB not required
  1.  I '$$RQAOB(DUZ(2)) Q 0
  1.  ;
  1.  Q:DFN="" 1
  1.  N X
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
  1.  I '$$HASELIG^AGEDERR2(DFN) Q 0
  1.  I '$$ISDEPEND^AGEDERR2(DFN) Q 0
  1.  ;AOB CHECKED FOR PATIENTS W/ PRVT ONLY
  1.  Q:'$D(^AUPNPRVT("B",DFN))
  1.  S X=1_U_"PVT"_U
  1.  Q:'$$ACTELIG^AGEDERR2(DFN,X)_U_X 0
  1.  ;END NEW
  1.  I $G(AGOPT("VERSION"))<7.1 Q $P($G(^AUPNPAT(DFN,0)),U,17)=""
  1.  Q $O(^AUPNPAT(DFN,71,0))=""
  1.  ;EDIT CHK #45 - AOB COMP
  1.  ;ERROR VERSION (SEE EDIT CHK #3 FOR WARNING VERSION)
  1.  ;LAST DATE IS OLDER THAN ONE YEAR OR BEFORE AN ACTIVE BEGIN DATE
  1. AOBDUE(DFN) ;EP
  1.  ;
  1.  ;Quit if AOB not required
  1.  I '$$RQAOB(DUZ(2)) Q 0
  1.  ;
  1.  Q:DFN="" 1
  1.  N TARDT,X,X1,X2,X3
  1.  ;1/20/05
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
  1.  I '$$HASELIG^AGEDERR2(DFN) Q 0
  1.  ;END NEW
  1.  ;ADRIAN 6/16/2005
  1.  ;AOB SHOULD BE CHECKED FOR PRVT INS. ONLY
  1.  Q:'$D(^AUPNPRVT("B",DFN)) 0
  1.  S X=1_U_"PVT"_U
  1.  Q:'$$ACTELIG^AGEDERR2(DFN,X)_U_X 0
  1.  S TARDT=$$AOBCHEK^AGEDERR2(DFN)
  1.  ;END
  1.  I $G(AGOPT("VERSION"))<7.1 Q $$AOBDUE7(DFN)
  1.  ;DON'T CHK IF NO AOB ENTRIES
  1.  ;S X3=$O(^AUPNPAT(DFN,71,"B",""),-1)
  1.  ;Q:X3="" 0
  1.  S X2=$O(^AUPNPAT(DFN,71,"B",""),-1)
  1.  Q:X2="" 0     ;DO NOT REPORT ON MISSING THATS FOR ERROR #1
  1.  Q:X2<TARDT 1  ;AOB
  1.  S X1=DT
  1.  D ^%DTC
  1.  Q X>365
  1.  ;7.0 CHK FOR AOB OVERDUE
  1. AOBDUE7(DFN) ;EP
  1.  I $P($G(^AUPNPAT(DFN,0)),U,17)="" Q 1
  1.  S X2=$P($G(^AUPNPAT(DFN,0)),U,17)
  1.  S X1=DT
  1.  D ^%DTC
  1.  Q X>365
  1.  ;
  1.  ;EDIT CHK #46 - ROI MISSING
  1.  ;ERROR VERSION (SEE EDIT CHK #13 FOR WARNING VERSION)
  1.  ;
  1. ROIMISS(DFN) ;EP
  1.  ;
  1.  ;Quit if ROI not required
  1.  I '$$RQROI(DUZ(2)) Q 0
  1.  ;
  1.  Q:DFN="" 1
  1.  ;
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
  1.  I '$$HASELIG^AGEDERR2(DFN) Q 0
  1.  ;
  1.  I '$$ISDEPEND^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
  1.  ;
  1.  I $G(AGOPT("VERSION"))<7.1 Q $P($G(^AUPNPAT(DFN,0)),U,4)=""
  1.  Q $O(^AUPNPAT(DFN,36,"B",""),-1)=""
  1.  ;
  1.  ;EDIT CHK #14 - ROI EXPIRED
  1.  ;RTNS T IF EXPIRED
  1. ROIEXP(DFN) ;EP
  1.  ;
  1.  ;Quit if ROI not required
  1.  I '$$RQROI(DUZ(2)) Q 0
  1.  ;
  1.  Q:DFN="" 1
  1.  ;1/20/05
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
  1.  I '$$HASELIG^AGEDERR2(DFN) Q 0
  1.  ;END
  1.  I $G(AGOPT("VERSION"))<7.1 Q $$ROIEXP7(DFN)  ;DO PRE 7.1 CHK
  1.  ;DON'T CHK IF NO ROI ENTRY
  1.  N X3
  1.  S X3=$O(^AUPNPAT(DFN,36,"B",""),-1)
  1.  Q:X3="" 0
  1.  N X,X1,X2
  1.  S X2=$O(^AUPNPAT(DFN,36,"B",""),-1)
  1.  Q:X2="" 1
  1.  S X1=DT
  1.  D ^%DTC
  1.  Q X>365
  1.  ;PRE 7.1 CHK FOR EXPIRED ROI
  1. ROIEXP7(DFN) ;EP
  1.  N X1,X2
  1.  S X2=$P($G(^AUPNPAT(DFN,0)),U,4)
  1.  S X1=DT
  1.  D ^%DTC
  1.  Q X>365
  1.  ;
  1.  ;EDIT CHK #48 - COMMUNITY MISSING
  1.  ;ERROR CHECK
  1. COMM(DFN) ;EP
  1.  ;
  1.  Q:DFN="" 1
  1.  N X
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
  1.  ;
  1.  I $$GET1^DIQ(9000001,DFN_",",1118,"E")="" Q 1
  1.  Q 0
  1.  ;
  1.  ;IHS/OIT/NKD AG*7.1*11 MU2 - ADD PATIENT SEX UNKNOWN WARNING
  1.  ;EDIT CHK #54 - PAT SEX UNKNOWN
  1.  ;RTNS T IF UNKNOWN
  1. PSEXUNK(DFN) ;EP
  1.  Q:DFN="" 1
  1.  I $$DECEASED^AGEDERR2(DFN) Q 0
  1.  I '$$PTACTIVE^AGEDERR2(DFN) Q 0
  1.  ;I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
  1.  ;I '$$HASELIG^AGEDERR2(DFN) Q 0
  1.  Q $$GET1^DIQ(2,DFN,.02,"I")="U"
  1.  ;
  1. RQROI(FAC) ;Determine whether ROI is required
  1.  N FLIEN,ROIEN,RQROI
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
  1.  S ROIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","RELEASE OF INFORMATION",""))
  1.  S RQROI=$$GET1^DIQ(9009061.1101,ROIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQROI
  1.  ;
  1. RQAOB(FAC) ;Determine whether AOB is required
  1.  N FLIEN,AOBIEN,RQAOB
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
  1.  S AOBIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","ASSIGN BENEFITS OBTAINED DATE",""))
  1.  S RQAOB=$$GET1^DIQ(9009061.1101,AOBIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQAOB
  1.  ;
  1. RQPRM(FAC) ;Determine whether Primary Language is required - AG*7.1*9
  1.  N FLIEN,PRMIEN,RQPRM
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
  1.  S PRMIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))
  1.  S RQPRM=$$GET1^DIQ(9009061.1101,PRMIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQPRM
  1.  ;
  1. RQPRF(FAC) ;Determine whether Preferred Language is required - AG*7.1*9
  1.  N FLIEN,PRFIEN,RQPRF
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
  1.  S PRFIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))
  1.  S RQPRF=$$GET1^DIQ(9009061.1101,PRFIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQPRF
  1.  ;
  1. RQETH(FAC) ;Determine whether Ethnicity is required - AG*7.1*9
  1.  N FLIEN,ETHIEN,RQETH
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",2,"")) I FLIEN="" Q 0
  1.  S ETHIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))
  1.  S RQETH=$$GET1^DIQ(9009061.1101,ETHIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQETH
  1.  ;
  1. RQRACE(FAC) ;Determine whether Race is required - AG*7.1*9
  1.  N FLIEN,RACEIEN,RQRACE
  1.  S FLIEN=$O(^AGFAC(FAC,11,"B",2,"")) I FLIEN="" Q 0
  1.  S RACEIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))
  1.  S RQRACE=$$GET1^DIQ(9009061.1101,RACEIEN_","_FLIEN_","_FAC_",",.02,"I")
  1.  Q RQRACE