ORPRF ;SLC/JLI-Patient record flag ;6/14/06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215,243**;Dec 17, 1997;Build 242
;
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,CAT1
; where CAT1 is 1 if flag is cat 1, 0 if cat 2
; ORY = Num of items returned in array ORY = num of flags
I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
N IDY,PRFARR,CAT1
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"))
. S CAT1=0
. I $G(^TMP("ORPRF",$J,IDY,"CATEGORY"))="I (NATIONAL)" S CAT1=1
. S ORY(IDY)=ORY(IDY)_U_CAT1
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
;
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
+2 ;
FMT(ROOT) ; Format - Convert record flag data to displayable data
+1 ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
+2 NEW IDX,IX,CNT
+3 SET (IDX,CNT)=0
+4 FOR
SET IDX=$ORDER(ROOT(IDX))
IF 'IDX
QUIT
Begin DoDot:1
+5 SET ^TMP("ORPRF",$JOB,IDX,"FLAG")=$PIECE($GET(ROOT(IDX,"FLAG")),U,2)
+6 SET ^TMP("ORPRF",$JOB,IDX,"CATEGORY")=$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)
+7 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Name: "_$PIECE($GET(ROOT(IDX,"FLAG")),U,2)
+8 IF $DATA(ROOT(IDX,"NARR"))
Begin DoDot:2
+9 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)=" "
+10 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Assignment Narrative: "
+11 SET IX=0
FOR
SET IX=$ORDER(ROOT(IDX,"NARR",IX))
IF 'IX
QUIT
Begin DoDot:3
+12 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)=$GET(ROOT(IDX,"NARR",IX,0))
End DoDot:3
End DoDot:2
+13 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)=" "
+14 ; -- Assignment Details:
+15 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Type: "_$PIECE($GET(ROOT(IDX,"FLAGTYPE")),U,2)
+16 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Category: "_$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)
+17 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Assignment Status: "_"Active"
+18 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Initial Assigned Date: "_$PIECE($GET(ROOT(IDX,"ASSIGNDT")),U,2)
+19 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Approved by: "_$PIECE($GET(ROOT(IDX,"APPRVBY")),U,2)
+20 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Next Review Date: "_$PIECE($GET(ROOT(IDX,"REVIEWDT")),U,2)
+21 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Owner Site: "_$PIECE($GET(ROOT(IDX,"OWNER")),U,2)
+22 SET CNT=CNT+1
SET ^TMP("ORPRF",$JOB,IDX,CNT)="Originating Site: "_$PIECE($GET(ROOT(IDX,"ORIGSITE")),U,2)
End DoDot:1
+23 KILL ROOT
+24 QUIT
+25 ;
HASFLG(ORY,PTDFN) ;Does patient PTDFN has flags
+1 ; DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)
+2 ; Returns array ORY listing active assigned flags
+3 ; Array ORY has form:
+4 ; ORY(flagID) = flagID^flagname,CAT1
+5 ; where CAT1 is 1 if flag is cat 1, 0 if cat 2
+6 ; ORY = Num of items returned in array ORY = num of flags
+7 IF '$LENGTH($TEXT(GETACT^DGPFAPI))
SET ORY=0
QUIT
+8 NEW IDY,PRFARR,CAT1
+9 KILL ^TMP("ORPRF",$JOB)
+10 SET ORY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
+11 IF 'ORY
QUIT
+12 ; Sets ^TMP("ORPRF"
DO FMT(.@("PRFARR"))
+13 SET IDY=0
FOR
SET IDY=$ORDER(^TMP("ORPRF",$JOB,IDY))
IF 'IDY
QUIT
Begin DoDot:1
+14 SET ORY(IDY)=IDY_U_$GET(^TMP("ORPRF",$JOB,IDY,"FLAG"))
+15 SET CAT1=0
+16 IF $GET(^TMP("ORPRF",$JOB,IDY,"CATEGORY"))="I (NATIONAL)"
SET CAT1=1
+17 SET ORY(IDY)=ORY(IDY)_U_CAT1
End DoDot:1
+18 QUIT
+19 ;
HASFLG1(ORY,PTDFN) ; Does patient PTDFN have **Cat I** flags
+1 ; Returns array ORY listing active assigned Cat I flags
+2 ; Array ORY has form:
+3 ; ORY(flagID) = flagID^flagname
+4 ; ORY = Num of Cat I flags
+5 ; If pt has no Cat I flags ORY = 0 and no flags are returned.
+6 ; Also calls FMT^ORPRF, which sets ^TMP("ORPRF" for Cat I flags
+7 ;
+8 IF '$LENGTH($TEXT(GETACT^DGPFAPI))
SET ORY=0
QUIT
+9 NEW FLAGID,PRFARR,CAT1CNT,ACTFLGS
+10 KILL ^TMP("ORPRF",$JOB)
+11 SET ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
+12 IF 'ACTFLGS
SET ORY=0
QUIT
+13 SET (FLAGID,CAT1CNT)=0
+14 FOR
SET FLAGID=$ORDER(PRFARR(FLAGID))
IF 'FLAGID
QUIT
Begin DoDot:1
+15 IF $PIECE($GET(PRFARR(FLAGID,"CATEGORY"))," ")="I"
SET CAT1CNT=CAT1CNT+1
QUIT
+16 KILL PRFARR(FLAGID)
End DoDot:1
+17 IF 'CAT1CNT
SET ORY=0
QUIT
+18 DO FMT(.@("PRFARR"))
+19 SET IDY=0
FOR
SET IDY=$ORDER(^TMP("ORPRF",$JOB,IDY))
IF 'IDY
QUIT
Begin DoDot:1
+20 SET ORY(IDY)=IDY_U_$GET(^TMP("ORPRF",$JOB,IDY,"FLAG"))
End DoDot:1
+21 SET ORY=CAT1CNT
+22 QUIT
+23 ;
HASCAT1(HASCAT1,PTDFN) ;Does patient have Category I flags (no arrays)
+1 ; Returns boolean HASCAT1 = 0 or 1
+2 ; Does NOT set arrays or TMP globals
+3 NEW FLAGID,PRFARR,ACTFLGS
+4 SET (HASCAT1,FLAGID)=0
+5 SET ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
IF 'ACTFLGS
GOTO HASCAT1X
+6 FOR
SET FLAGID=$ORDER(PRFARR(FLAGID))
IF 'FLAGID
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(PRFARR(FLAGID,"CATEGORY"))," ")="I"
SET HASCAT1=1
End DoDot:1
IF HASCAT1
QUIT
HASCAT1X ;
+1 QUIT
+2 ;
TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection
+1 ; for patient PTDFN?
+2 ;As of 1/10/06, returns POPUP as:
+3 ; 1 if pt has any active flags, either Cat I or Cat II
+4 ; 0 otherwise
+5 NEW PRFARR
+6 SET POPUP=$SELECT($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)
+7 QUIT
+8 ;
GETFLG(ORY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID
+1 IF '$DATA(^TMP("ORPRF",$JOB,FLAGID))
QUIT
+2 NEW IX,CNT
+3 SET (IX,CNT)=0
+4 FOR
SET IX=$ORDER(^TMP("ORPRF",$JOB,FLAGID,IX))
IF 'IX
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET ORY(CNT)=$GET(^TMP("ORPRF",$JOB,FLAGID,IX))
End DoDot:1
+6 QUIT
+7 ;
CLEAR(ORY) ;Clear up the temp global
+1 KILL ^TMP("ORPRF",$JOB)
+2 QUIT
+3 ;
