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

DGPFAPIU.m

Go to the documentation of this file. 
  1. DGPFAPIU ;ALB/SCK - PRF API UTILITIES FOR HIGH RISK MENTAL HEALTH ;Jan 21, 2011
  1.  ;;5.3;Registration;**836,971**;Aug 13, 1993;Build 5
  1.  ;
  1.  Q  ; No direct entry
  1.  ;
  1. CHKDATE(DGSTART,DGEND,DGRANGE) ; Check for valid start and end dates, set DGRANGE parameter
  1.  N DGRSLT
  1.  ;
  1.  S DGSTART=+$G(DGSTART),DGEND=+$G(DGEND)
  1.  S:DGSTART<0 DGSTART=0
  1.  ;
  1.  I 'DGSTART&('DGEND) D
  1.  . S DGRANGE="A"
  1.  . S DGSTART=0,DGEND=$P($$NOW^XLFDT,".")
  1.  E  D
  1.  . S DGRANGE="S"
  1.  ;
  1.  S DGRANGE("START")=DGSTART,DGRANGE("END")=DGEND
  1.  Q 1
  1.  ;
  1. CHKDFN(DGDFN,DGNAME) ; Check for a valid entry in the PATIENT file
  1.  N DGERR,DGRSLT
  1.  ;
  1.  S DGRSLT=1
  1.  S DGNAME=$$GET1^DIQ(2,DGDFN,.01,,,"DGERR")
  1.  I $D(DGERR) S DGRSLT=0,DGNAME=DGERR("DIERR",1,"TEXT",1)
  1.  Q $G(DGRSLT)
  1.  ;
  1. ASGNDATE(DGIEN) ; Get intial assignment date from new record history entry
  1.  N DGRSLT,DGX
  1.  ;
  1.  S DGX=0
  1.  F  S DGX=$O(^DGPF(26.14,"B",DGIEN,DGX)) Q:'DGX  D
  1.  . I $P($G(^DGPF(26.14,DGX,0)),U,3)=1 S DGRSLT=$P($G(^DGPF(26.14,DGX,0)),U,2)
  1.  ;
  1.  Q +$G(DGRSLT)
  1.  ;
  1. GETFLAG(DGPRF,DGCAT) ; Get the variable pointer value for the flag text passed in
  1.  ;  Input:  DGPRF - Flag name, i.e. BEHAVIORAL
  1.  ;          DGCAT - Flag Category, N - National  [Optional]
  1.  ;                                 L - Local
  1.  ;
  1.  ;  Output:  Returns the variable pointer value for the flag, i.e. "1;DGPF(25.15"
  1.  ;           If not found, returns "-1;NOT FOUND"
  1.  ;           If not Active, returns "-1;NOt ACTIVE"
  1.  ;
  1.  N DGIEN,DGDONE,DGRSLT,DGSTAT
  1.  ;
  1.  S DGCAT=$G(DGCAT)
  1.  S DGCAT=$S(DGCAT="N":1,DGCAT="L":2,1:0)
  1.  ;
  1.  I DGCAT=1 D
  1.  . S DGIEN=$O(^DGPF(26.15,"B",DGPRF,0))
  1.  . I DGIEN S DGDONE=1,DGRSLT=DGIEN_";DGPF(26.15,"
  1.  ;
  1.  I DGCAT=2 D
  1.  . S DGIEN=$O(^DGPF(26.11,"B",DGPRF,0))
  1.  . I DGIEN S DGDONE=1,DGRSLT=DGIEN_";DGPF(26.11,"
  1.  ;
  1.  I DGCAT=0 D
  1.  . ; Check the PRF local flag file for the flag first.  If found, return the appropriate variable pointer
  1.  . S DGIEN=$O(^DGPF(26.11,"B",DGPRF,0))
  1.  . I DGIEN S DGDONE=1,DGRSLT=DGIEN_";DGPF(26.11,"
  1.  . ; If not found in the PRF Local Flag file, then check the PRF National Flag file.  If found, return the appropriate variable pointer. 
  1.  . I '$G(DGDONE) D
  1.  .. S DGIEN=$O(^DGPF(26.15,"B",DGPRF,0))
  1.  .. I DGIEN S DGDONE=1,DGRSLT=DGIEN_";DGPF(26.15,"
  1.  ;
  1.  I '$G(DGDONE) S DGRSLT="-1;NOT FOUND"
  1.  ;
  1.  ; Check active status
  1.  I +$G(DGRSLT)>0 D
  1.  . S DGSTAT=$$GET1^DIQ($S(DGRSLT[26.11:26.11,1:26.15),+DGRSLT,.02,"I")
  1.  . I 'DGSTAT S DGRSLT="-1;NOT ACTIVE"
  1.  ; 
  1.  Q $G(DGRSLT)
  1.  ;
  1. ACTIVE(DGIEN,DGRANGE) ; Check if "active" during date range
  1.  ; Input
  1.  ;       DGIEN    - Pointer to PRF Assignment File (#26.13)
  1.  ;       DGRANGE  - Array containg Start Date/End Date
  1.  ;
  1.  ; Output
  1.  ;       DGRSLT: 1 - "Active"
  1.  ;               0 - "Not Active"
  1.  ;
  1.  N DGDT,DGX,DGACT,DGRSLT,DGACT2,DGPRE,DGPST,DGRSLT,DGCNT,DGDTPRE,DGDTPST
  1.  ;
  1.  S DGRSLT=0
  1.  ; Build array of actions fro processing
  1.  S (DGCNT,DGDT)=0
  1.  F  S DGDT=$O(^DGPF(26.14,"C",DGIEN,DGDT)) Q:'DGDT  D
  1.  . S DGX=$O(^DGPF(26.14,"C",DGIEN,DGDT,0)) Q:'DGX
  1.  . S DGACT(DGX)=$P($G(^DGPF(26.14,DGX,0)),U,3)_"^"_$P($P($G(^DGPF(26.14,DGX,0)),U,2),".")
  1.  . S DGCNT=DGCNT+1
  1.  S DGACT=DGCNT
  1.  ;
  1.  ; Check for last action of Entered in Error, if there is one, all previous actions are void
  1.  ; Quit, returning inactive status
  1.  S DGX=$O(DGACT(99999999),-1)
  1.  I $P(DGACT(DGX),U)=5 S DGRSLT=0 G CHKQ
  1.  ;
  1.  ; Begin checking history file
  1.  I DGRANGE["A" D
  1.  . I DGACT=1 D  ; If only one entry, should be NEW, process as active
  1.  .. S DGX=$O(DGACT(0))
  1.  .. S DGRSLT=$S($P(DGACT(DGX),U)=1:1,1:0)
  1.  . E  D
  1.  .. S DGX=$O(DGACT(99999999),-1)
  1.  .. I "3,5"[$P(DGACT(DGX),U) S DGRSLT=0 ; Check last entry for EiE or Inact
  1.  .. E  S DGRSLT=1
  1.  E  D
  1.  . I $P($$ASGNDATE^DGPFAPIU(DGIEN),".")>DGRANGE("END") S DGRSLT=0 Q
  1.  . S (DGACT2,DGX)=0
  1.  . F  S DGX=$O(DGACT(DGX)) Q:'DGX  D
  1.  .. I $P(DGACT(DGX),U,2)>DGRANGE("START")&($P(DGACT(DGX),U,2)<=DGRANGE("END")) S DGACT2(DGX)=DGACT(DGX),DGACT2=DGACT2+1 ; DG*971 Inclusive Range
  1.  . ; If actions are found within the date range, process for active status.
  1.  . I DGACT2>0 D
  1.  .. S DGX=0 F  S DGX=$O(DGACT2(DGX)) Q:'DGX  D
  1.  ... S DGRSLT=$S("1,2,4"[$P(DGACT2(DGX),U):1,1:0)
  1.  . ; If no action entry is found within the date range specified, then try to determine the status from
  1.  . ; the nearest action.
  1.  . E  D
  1.  .. S DGDTPRE=DGRANGE("START")_".999999"
  1.  .. S DGDTPRE=$O(^DGPF(26.14,"C",DGIEN,DGDTPRE),-1)
  1.  .. S DGPRE=$S(DGDTPRE>0:$O(^DGPF(26.14,"C",DGIEN,DGDTPRE,0)),1:0)
  1.  .. S DGDTPST=$O(^DGPF(26.14,"C",DGIEN,DGRANGE("END")))
  1.  .. S DGPST=$S(DGDTPST>0:$O(^DGPF(26.14,"C",DGIEN,DGDTPST,0)),1:0)
  1.  .. S DGRSLT=$S("1,2,4"[$P(DGACT(DGPRE),U):1,1:0)
  1.  .. I DGPST>0,$P(DGACT(DGPST),U)="5" S DGRSLT=0
  1.  ;
  1. CHKQ ;
  1.  ;
  1.  Q +$G(DGRSLT)