- ORPRF ;SLC/JLI/JMC -Patient record flag ;6/14/06
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215,243,472,542**;Dec 17, 1997;Build 11
- ;
- FMT(ROOT,DBRSDATA,DGHIST) ; Format - Convert record flag data to displayable data
- ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
- ; DBRSDATA - local array with DBRS data
- ; DGHIST - local array with PRF history records
- N IDX,IX,CNT,CURFLAG
- 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)
- . ;DBRS data
- . I $O(DBRSDATA("BEHAVIORAL",0)) I $P($G(ROOT(IDX,"FLAG")),U,2)="BEHAVIORAL" D
- . . N ORDBRSC,ORZDBRSD
- . . S ORDBRSC=0 F S ORDBRSC=+$O(DBRSDATA("BEHAVIORAL",ORDBRSC)) Q:ORDBRSC=0 D
- . . . S ORZDBRSD=$G(DBRSDATA("BEHAVIORAL",ORDBRSC))
- . . . I $P(ORZDBRSD,U,1)']"" Q
- . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="DBRS number: "_$P(ORZDBRSD,U,1)
- . . . I $P(ORZDBRSD,U,2)]"" S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Other DBRS data: "_$P(ORZDBRSD,U,2)
- . ;check if any history for the PRF flag that is being processed now
- . S CURFLAG=$P($G(ROOT(IDX,"FLAG")),U,2)
- . I $O(DGHIST(CURFLAG,0)) D
- . . N ORPRFHCN,ORPRFHDA,ORPRFSIT,ORQUIT
- . . S ORPRFSIT="",ORQUIT=0
- . . S ORPRFHCN=0 F S ORPRFHCN=+$O(DGHIST(CURFLAG,ORPRFHCN)) Q:ORPRFHCN=0!(ORQUIT=1) D Q:ORQUIT=1
- . . . I $D(DGHIST(CURFLAG,ORPRFHCN)),ORPRFHCN>10 D Q:ORQUIT=1
- . . . . S ORQUIT=1
- . . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="*** Additional information is in VistA ***"
- . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=""
- . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="History of Actions Taken:"
- . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Date Action Site ID Site Name"
- . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="------------------------------------------------"
- . . . S ORPRFHDA=$G(DGHIST(CURFLAG,ORPRFHCN)) Q:ORPRFHDA=""
- . . . ;I ORPRFSIT'=$P(ORPRFHDA,U) S ORPRFSIT=$P(ORPRFHDA,U) S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=ORPRFSIT_" changes:"
- . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=$P($P(ORPRFHDA,U,2),"@",1)_" "_$$LJ^XLFSTR($P(ORPRFHDA,U,3),15)_" "_$$LJ^XLFSTR($P(ORPRFHDA,U,4),8)_" "_$$LJ^XLFSTR($E($P(ORPRFHDA,U,1),1,20),30)
- 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
- ;
- N DBRSARR,PRFHIST
- ;ICR# 6874 - check if DG*5.3*951 installed and then call the API to get DBRS information
- I $T(GETDBRS^DGPFDBRS)'="" I $$GETDBRS^DGPFDBRS(PTDFN,.DBRSARR)
- ;get history records for active PRFs
- D ACTPRFHS^ORPRFHST(PTDFN,.PRFHIST)
- ;
- D FMT(.@("PRFARR"),.DBRSARR,.PRFHIST) ; 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRF 6444 printed Jan 18, 2025@03:33:54 Page 2
- ORPRF ;SLC/JLI/JMC -Patient record flag ;6/14/06
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215,243,472,542**;Dec 17, 1997;Build 11
- +2 ;
- FMT(ROOT,DBRSDATA,DGHIST) ; Format - Convert record flag data to displayable data
- +1 ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
- +2 ; DBRSDATA - local array with DBRS data
- +3 ; DGHIST - local array with PRF history records
- +4 NEW IDX,IX,CNT,CURFLAG
- +5 SET (IDX,CNT)=0
- +6 FOR
- SET IDX=$ORDER(ROOT(IDX))
- if 'IDX
- QUIT
- Begin DoDot:1
- +7 SET ^TMP("ORPRF",$JOB,IDX,"FLAG")=$PIECE($GET(ROOT(IDX,"FLAG")),U,2)
- +8 SET ^TMP("ORPRF",$JOB,IDX,"CATEGORY")=$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)
- +9 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Name: "_$PIECE($GET(ROOT(IDX,"FLAG")),U,2)
- +10 IF $DATA(ROOT(IDX,"NARR"))
- Begin DoDot:2
- +11 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)=" "
- +12 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Assignment Narrative: "
- +13 SET IX=0
- FOR
- SET IX=$ORDER(ROOT(IDX,"NARR",IX))
- if 'IX
- QUIT
- Begin DoDot:3
- +14 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)=$GET(ROOT(IDX,"NARR",IX,0))
- End DoDot:3
- End DoDot:2
- +15 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)=" "
- +16 ; -- Assignment Details:
- +17 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Type: "_$PIECE($GET(ROOT(IDX,"FLAGTYPE")),U,2)
- +18 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Flag Category: "_$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)
- +19 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Assignment Status: "_"Active"
- +20 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Initial Assigned Date: "_$PIECE($GET(ROOT(IDX,"ASSIGNDT")),U,2)
- +21 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Approved by: "_$PIECE($GET(ROOT(IDX,"APPRVBY")),U,2)
- +22 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Next Review Date: "_$PIECE($GET(ROOT(IDX,"REVIEWDT")),U,2)
- +23 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Owner Site: "_$PIECE($GET(ROOT(IDX,"OWNER")),U,2)
- +24 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Originating Site: "_$PIECE($GET(ROOT(IDX,"ORIGSITE")),U,2)
- +25 ;DBRS data
- +26 IF $ORDER(DBRSDATA("BEHAVIORAL",0))
- IF $PIECE($GET(ROOT(IDX,"FLAG")),U,2)="BEHAVIORAL"
- Begin DoDot:2
- +27 NEW ORDBRSC,ORZDBRSD
- +28 SET ORDBRSC=0
- FOR
- SET ORDBRSC=+$ORDER(DBRSDATA("BEHAVIORAL",ORDBRSC))
- if ORDBRSC=0
- QUIT
- Begin DoDot:3
- +29 SET ORZDBRSD=$GET(DBRSDATA("BEHAVIORAL",ORDBRSC))
- +30 IF $PIECE(ORZDBRSD,U,1)']""
- QUIT
- +31 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="DBRS number: "_$PIECE(ORZDBRSD,U,1)
- +32 IF $PIECE(ORZDBRSD,U,2)]""
- SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Other DBRS data: "_$PIECE(ORZDBRSD,U,2)
- End DoDot:3
- End DoDot:2
- +33 ;check if any history for the PRF flag that is being processed now
- +34 SET CURFLAG=$PIECE($GET(ROOT(IDX,"FLAG")),U,2)
- +35 IF $ORDER(DGHIST(CURFLAG,0))
- Begin DoDot:2
- +36 NEW ORPRFHCN,ORPRFHDA,ORPRFSIT,ORQUIT
- +37 SET ORPRFSIT=""
- SET ORQUIT=0
- +38 SET ORPRFHCN=0
- FOR
- SET ORPRFHCN=+$ORDER(DGHIST(CURFLAG,ORPRFHCN))
- if ORPRFHCN=0!(ORQUIT=1)
- QUIT
- Begin DoDot:3
- +39 IF $DATA(DGHIST(CURFLAG,ORPRFHCN))
- IF ORPRFHCN>10
- Begin DoDot:4
- +40 SET ORQUIT=1
- +41 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="*** Additional information is in VistA ***"
- End DoDot:4
- if ORQUIT=1
- QUIT
- +42 IF ORPRFHCN=1
- SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)=""
- +43 IF ORPRFHCN=1
- SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="History of Actions Taken:"
- +44 IF ORPRFHCN=1
- SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="Date Action Site ID Site Name"
- +45 IF ORPRFHCN=1
- SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)="------------------------------------------------"
- +46 SET ORPRFHDA=$GET(DGHIST(CURFLAG,ORPRFHCN))
- if ORPRFHDA=""
- QUIT
- +47 ;I ORPRFSIT'=$P(ORPRFHDA,U) S ORPRFSIT=$P(ORPRFHDA,U) S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=ORPRFSIT_" changes:"
- +48 SET CNT=CNT+1
- SET ^TMP("ORPRF",$JOB,IDX,CNT)=$PIECE($PIECE(ORPRFHDA,U,2),"@",1)_" "_$$LJ^XLFSTR($PIECE(ORPRFHDA,U,3),15)_" "_$$LJ^XLFSTR($PIECE(ORPRFHDA,U,4),8)_" "_$$LJ^XLFSTR($EXTRACT($PIECE(ORPRFHDA,U,1),1,20),30)
- End DoDot:3
- if ORQUIT=1
- QUIT
- End DoDot:2
- End DoDot:1
- +49 KILL ROOT
- +50 QUIT
- +51 ;
- 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 ;
- +13 NEW DBRSARR,PRFHIST
- +14 ;ICR# 6874 - check if DG*5.3*951 installed and then call the API to get DBRS information
- +15 IF $TEXT(GETDBRS^DGPFDBRS)'=""
- IF $$GETDBRS^DGPFDBRS(PTDFN,.DBRSARR)
- +16 ;get history records for active PRFs
- +17 DO ACTPRFHS^ORPRFHST(PTDFN,.PRFHIST)
- +18 ;
- +19 ; Sets ^TMP("ORPRF"
- DO FMT(.@("PRFARR"),.DBRSARR,.PRFHIST)
- +20 SET IDY=0
- FOR
- SET IDY=$ORDER(^TMP("ORPRF",$JOB,IDY))
- if 'IDY
- QUIT
- Begin DoDot:1
- +21 SET ORY(IDY)=IDY_U_$GET(^TMP("ORPRF",$JOB,IDY,"FLAG"))
- +22 SET CAT1=0
- +23 IF $GET(^TMP("ORPRF",$JOB,IDY,"CATEGORY"))="I (NATIONAL)"
- SET CAT1=1
- +24 SET ORY(IDY)=ORY(IDY)_U_CAT1
- End DoDot:1
- +25 QUIT
- +26 ;
- 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 ;