- 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 ;