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

ORPRF.m

Go to the documentation of this file.
  1. ORPRF ;SLC/JLI-Patient record flag ;6/14/06
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215,243**;Dec 17, 1997;Build 242
  1. ;
  1. FMT(ROOT) ; Format - Convert record flag data to displayable data
  1. ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
  1. N IDX,IX,CNT
  1. S (IDX,CNT)=0
  1. F S IDX=$O(ROOT(IDX)) Q:'IDX D
  1. . S ^TMP("ORPRF",$J,IDX,"FLAG")=$P($G(ROOT(IDX,"FLAG")),U,2)
  1. . S ^TMP("ORPRF",$J,IDX,"CATEGORY")=$P($G(ROOT(IDX,"CATEGORY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Name: "_$P($G(ROOT(IDX,"FLAG")),U,2)
  1. . I $D(ROOT(IDX,"NARR")) D
  1. . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
  1. . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Narrative: "
  1. . . S IX=0 F S IX=$O(ROOT(IDX,"NARR",IX)) Q:'IX D
  1. . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=$G(ROOT(IDX,"NARR",IX,0))
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
  1. . ; -- Assignment Details:
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Type: "_$P($G(ROOT(IDX,"FLAGTYPE")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Category: "_$P($G(ROOT(IDX,"CATEGORY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Status: "_"Active"
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Initial Assigned Date: "_$P($G(ROOT(IDX,"ASSIGNDT")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Approved by: "_$P($G(ROOT(IDX,"APPRVBY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Next Review Date: "_$P($G(ROOT(IDX,"REVIEWDT")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Owner Site: "_$P($G(ROOT(IDX,"OWNER")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Originating Site: "_$P($G(ROOT(IDX,"ORIGSITE")),U,2)
  1. K ROOT
  1. Q
  1. ;
  1. HASFLG(ORY,PTDFN) ;Does patient PTDFN has flags
  1. ; DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)
  1. ; Returns array ORY listing active assigned flags
  1. ; Array ORY has form:
  1. ; ORY(flagID) = flagID^flagname,CAT1
  1. ; where CAT1 is 1 if flag is cat 1, 0 if cat 2
  1. ; ORY = Num of items returned in array ORY = num of flags
  1. I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
  1. N IDY,PRFARR,CAT1
  1. K ^TMP("ORPRF",$J)
  1. S ORY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
  1. Q:'ORY
  1. D FMT(.@("PRFARR")) ; Sets ^TMP("ORPRF"
  1. S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
  1. . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
  1. . S CAT1=0
  1. . I $G(^TMP("ORPRF",$J,IDY,"CATEGORY"))="I (NATIONAL)" S CAT1=1
  1. . S ORY(IDY)=ORY(IDY)_U_CAT1
  1. Q
  1. ;
  1. HASFLG1(ORY,PTDFN) ; Does patient PTDFN have **Cat I** flags
  1. ; Returns array ORY listing active assigned Cat I flags
  1. ; Array ORY has form:
  1. ; ORY(flagID) = flagID^flagname
  1. ; ORY = Num of Cat I flags
  1. ; If pt has no Cat I flags ORY = 0 and no flags are returned.
  1. ; Also calls FMT^ORPRF, which sets ^TMP("ORPRF" for Cat I flags
  1. ;
  1. I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
  1. N FLAGID,PRFARR,CAT1CNT,ACTFLGS
  1. K ^TMP("ORPRF",$J)
  1. S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
  1. I 'ACTFLGS S ORY=0 Q
  1. S (FLAGID,CAT1CNT)=0
  1. F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D
  1. . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S CAT1CNT=CAT1CNT+1 Q
  1. . K PRFARR(FLAGID)
  1. I 'CAT1CNT S ORY=0 Q
  1. D FMT(.@("PRFARR"))
  1. S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
  1. . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
  1. S ORY=CAT1CNT
  1. Q
  1. ;
  1. HASCAT1(HASCAT1,PTDFN) ;Does patient have Category I flags (no arrays)
  1. ; Returns boolean HASCAT1 = 0 or 1
  1. ; Does NOT set arrays or TMP globals
  1. N FLAGID,PRFARR,ACTFLGS
  1. S (HASCAT1,FLAGID)=0
  1. S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR") I 'ACTFLGS G HASCAT1X
  1. F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D Q:HASCAT1
  1. . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S HASCAT1=1
  1. HASCAT1X ;
  1. Q
  1. ;
  1. TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection
  1. ; for patient PTDFN?
  1. ;As of 1/10/06, returns POPUP as:
  1. ; 1 if pt has any active flags, either Cat I or Cat II
  1. ; 0 otherwise
  1. N PRFARR
  1. S POPUP=$S($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)
  1. Q
  1. ;
  1. GETFLG(ORY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID
  1. I '$D(^TMP("ORPRF",$J,FLAGID)) Q
  1. N IX,CNT
  1. S (IX,CNT)=0
  1. F S IX=$O(^TMP("ORPRF",$J,FLAGID,IX)) Q:'IX D
  1. . S CNT=CNT+1,ORY(CNT)=$G(^TMP("ORPRF",$J,FLAGID,IX))
  1. Q
  1. ;
  1. CLEAR(ORY) ;Clear up the temp global
  1. K ^TMP("ORPRF",$J)
  1. Q
  1. ;