ORPRFHST ;SLC/SS/JMC/RM - Active Patient Record flag history ;Sep 23, 2021@13:10
;;3.0;ORDER ENTRY/RESULTS REPORTING;**542,574**;Dec 17, 1997;Build 1
;
;ICRs
;
;7107 - $$GETALL^DGPFAA and $$GETASGN^DGPFAA
;7108 - $$GETHIST^DGPFAAH
;7214 - $$GETALLDT^DGPFAAH
;2171 - $$STA^XUAF4
;
ACTPRFHS(ORDFN,RETARR) ;
N ORRET,ORIEN13,ORIENS,ORARRH,ORFLGNM,ORARFLAG,ORCNT,ORDTTM,ORIEN14,ORZ
I '$$GETALL^DGPFAA(ORDFN,.ORRET,"",1) Q
S ORIEN13="" F S ORIEN13=$O(ORRET(ORIEN13)) Q:ORIEN13="" D
. K ORARFLAG
. I '$$GETASGN^DGPFAA(ORIEN13,.ORARFLAG) Q
. S ORFLGNM=$P(ORARFLAG("FLAG"),U,2)
. I '$L(ORFLGNM) Q
. K ORIENS
. I '$$GETALLDT^DGPFAAH(ORIEN13,.ORIENS) Q
. S ORCNT=0
. S ORDTTM="" F S ORDTTM=$O(ORIENS(ORDTTM)) Q:+ORDTTM=0 S ORIEN14=$G(ORIENS(ORDTTM)) I ORIEN14 D
. . K ORARRH
. . I '$$GETHIST^DGPFAAH(ORIEN14,.ORARRH,1) Q
. . S ORZ="^"_$P(ORARRH("ACTION"),U,2)_"^"
. . ; ignore if the action is not in the list
. . ; Added NEW ASSIGNMENT as an action to be included in the list.
. . I "^INACTIVATE^REACTIVATE^CONTINUE^NEW ASSIGNMENT^"'[ORZ Q
. . S ORCNT=ORCNT+1
. . ;OR*3.0*574: Display station number instead of institution IEN
. . N ORSTATN
. . S ORSTATN=$$STA^XUAF4($P(ORARRH("ORIGFAC"),U,1))
. . S RETARR(ORFLGNM,ORCNT)=$P(ORARRH("ORIGFAC"),U,2)_U_$P(ORARRH("ASSIGNDT"),U,2)_U_$P(ORARRH("ACTION"),U,2)_U
. . S RETARR(ORFLGNM,ORCNT)=RETARR(ORFLGNM,ORCNT)_$S(ORSTATN]"":ORSTATN,1:"unknown")
D REVERSE
Q
;
REVERSE ; Reverse the order of entries so most recent displays on top
N REVFLG,REVNUM,REVCNT,RETARR2
S REVFLG=""
F S REVFLG=$O(RETARR(REVFLG)) Q:REVFLG="" D
. S REVNUM="",REVCNT=1
. F S REVNUM=$O(RETARR(REVFLG,REVNUM),-1) Q:REVNUM="" D
. . S RETARR2(REVFLG,REVCNT)=$G(RETARR(REVFLG,REVNUM))
. . S REVCNT=REVCNT+1
K RETARR
M RETARR=RETARR2
K RETARR2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRFHST 1849 printed Sep 23, 2025@20:09:05 Page 2
ORPRFHST ;SLC/SS/JMC/RM - Active Patient Record flag history ;Sep 23, 2021@13:10
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**542,574**;Dec 17, 1997;Build 1
+2 ;
+3 ;ICRs
+4 ;
+5 ;7107 - $$GETALL^DGPFAA and $$GETASGN^DGPFAA
+6 ;7108 - $$GETHIST^DGPFAAH
+7 ;7214 - $$GETALLDT^DGPFAAH
+8 ;2171 - $$STA^XUAF4
+9 ;
ACTPRFHS(ORDFN,RETARR) ;
+1 NEW ORRET,ORIEN13,ORIENS,ORARRH,ORFLGNM,ORARFLAG,ORCNT,ORDTTM,ORIEN14,ORZ
+2 IF '$$GETALL^DGPFAA(ORDFN,.ORRET,"",1)
QUIT
+3 SET ORIEN13=""
FOR
SET ORIEN13=$ORDER(ORRET(ORIEN13))
if ORIEN13=""
QUIT
Begin DoDot:1
+4 KILL ORARFLAG
+5 IF '$$GETASGN^DGPFAA(ORIEN13,.ORARFLAG)
QUIT
+6 SET ORFLGNM=$PIECE(ORARFLAG("FLAG"),U,2)
+7 IF '$LENGTH(ORFLGNM)
QUIT
+8 KILL ORIENS
+9 IF '$$GETALLDT^DGPFAAH(ORIEN13,.ORIENS)
QUIT
+10 SET ORCNT=0
+11 SET ORDTTM=""
FOR
SET ORDTTM=$ORDER(ORIENS(ORDTTM))
if +ORDTTM=0
QUIT
SET ORIEN14=$GET(ORIENS(ORDTTM))
IF ORIEN14
Begin DoDot:2
+12 KILL ORARRH
+13 IF '$$GETHIST^DGPFAAH(ORIEN14,.ORARRH,1)
QUIT
+14 SET ORZ="^"_$PIECE(ORARRH("ACTION"),U,2)_"^"
+15 ; ignore if the action is not in the list
+16 ; Added NEW ASSIGNMENT as an action to be included in the list.
+17 IF "^INACTIVATE^REACTIVATE^CONTINUE^NEW ASSIGNMENT^"'[ORZ
QUIT
+18 SET ORCNT=ORCNT+1
+19 ;OR*3.0*574: Display station number instead of institution IEN
+20 NEW ORSTATN
+21 SET ORSTATN=$$STA^XUAF4($PIECE(ORARRH("ORIGFAC"),U,1))
+22 SET RETARR(ORFLGNM,ORCNT)=$PIECE(ORARRH("ORIGFAC"),U,2)_U_$PIECE(ORARRH("ASSIGNDT"),U,2)_U_$PIECE(ORARRH("ACTION"),U,2)_U
+23 SET RETARR(ORFLGNM,ORCNT)=RETARR(ORFLGNM,ORCNT)_$SELECT(ORSTATN]"":ORSTATN,1:"unknown")
End DoDot:2
End DoDot:1
+24 DO REVERSE
+25 QUIT
+26 ;
REVERSE ; Reverse the order of entries so most recent displays on top
+1 NEW REVFLG,REVNUM,REVCNT,RETARR2
+2 SET REVFLG=""
+3 FOR
SET REVFLG=$ORDER(RETARR(REVFLG))
if REVFLG=""
QUIT
Begin DoDot:1
+4 SET REVNUM=""
SET REVCNT=1
+5 FOR
SET REVNUM=$ORDER(RETARR(REVFLG,REVNUM),-1)
if REVNUM=""
QUIT
Begin DoDot:2
+6 SET RETARR2(REVFLG,REVCNT)=$GET(RETARR(REVFLG,REVNUM))
+7 SET REVCNT=REVCNT+1
End DoDot:2
End DoDot:1
+8 KILL RETARR
+9 MERGE RETARR=RETARR2
+10 KILL RETARR2
+11 QUIT
