source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRF.m@ 1683

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