- 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 Mar 13, 2025@21:37:45 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
