source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRF.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1ORPRF ;SLC/JLI-Patient record flag ;1/10/06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215**;Dec 17, 1997
3 ;
4FMT(ROOT) ; Format - Convert record flag data to displayable data
5 ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
6 N IDX,IX,CNT
7 S (IDX,CNT)=0
8 F S IDX=$O(ROOT(IDX)) Q:'IDX D
9 . S ^TMP("ORPRF",$J,IDX,"FLAG")=$P($G(ROOT(IDX,"FLAG")),U,2)
10 . S ^TMP("ORPRF",$J,IDX,"CATEGORY")=$P($G(ROOT(IDX,"CATEGORY")),U,2)
11 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Name: "_$P($G(ROOT(IDX,"FLAG")),U,2)
12 . I $D(ROOT(IDX,"NARR")) D
13 . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
14 . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Narrative: "
15 . . S IX=0 F S IX=$O(ROOT(IDX,"NARR",IX)) Q:'IX D
16 . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=$G(ROOT(IDX,"NARR",IX,0))
17 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
18 . ; -- Assignment Details:
19 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Type: "_$P($G(ROOT(IDX,"FLAGTYPE")),U,2)
20 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Category: "_$P($G(ROOT(IDX,"CATEGORY")),U,2)
21 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Status: "_"Active"
22 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Initial Assigned Date: "_$P($G(ROOT(IDX,"ASSIGNDT")),U,2)
23 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Approved by: "_$P($G(ROOT(IDX,"APPRVBY")),U,2)
24 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Next Review Date: "_$P($G(ROOT(IDX,"REVIEWDT")),U,2)
25 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Owner Site: "_$P($G(ROOT(IDX,"OWNER")),U,2)
26 . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Originating Site: "_$P($G(ROOT(IDX,"ORIGSITE")),U,2)
27 K ROOT
28 Q
29 ;
30HASFLG(ORY,PTDFN) ;Does patient PTDFN has flags
31 ; DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)
32 ; Returns array ORY listing active assigned flags
33 ; Array ORY has form:
34 ; ORY(flagID) = flagID^flagname
35 ; ORY = Num of items returned in array ORY = num of flags
36 I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
37 N IDY,PRFARR
38 K ^TMP("ORPRF",$J)
39 S ORY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
40 Q:'ORY
41 D FMT(.@("PRFARR")) ; Sets ^TMP("ORPRF"
42 S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
43 . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
44 Q
45 ;
46HASFLG1(ORY,PTDFN) ; Does patient PTDFN have **Cat I** flags
47 ; Returns array ORY listing active assigned Cat I flags
48 ; Array ORY has form:
49 ; ORY(flagID) = flagID^flagname
50 ; ORY = Num of Cat I flags
51 ; If pt has no Cat I flags ORY = 0 and no flags are returned.
52 ; Also calls FMT^ORPRF, which sets ^TMP("ORPRF" for Cat I flags
53 ;
54 I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
55 N FLAGID,PRFARR,CAT1CNT,ACTFLGS
56 K ^TMP("ORPRF",$J)
57 S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
58 I 'ACTFLGS S ORY=0 Q
59 S (FLAGID,CAT1CNT)=0
60 F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D
61 . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S CAT1CNT=CAT1CNT+1 Q
62 . K PRFARR(FLAGID)
63 I 'CAT1CNT S ORY=0 Q
64 D FMT(.@("PRFARR"))
65 S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
66 . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
67 S ORY=CAT1CNT
68 Q
69 ;
70HASCAT1(HASCAT1,PTDFN) ;Does patient have Category I flags (no arrays)
71 ; Returns boolean HASCAT1 = 0 or 1
72 ; Does NOT set arrays or TMP globals
73 N FLAGID,PRFARR,ACTFLGS
74 S (HASCAT1,FLAGID)=0
75 S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR") I 'ACTFLGS G HASCAT1X
76 F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D Q:HASCAT1
77 . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S HASCAT1=1
78HASCAT1X ;
79 Q
80 ;
81TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection
82 ; for patient PTDFN?
83 ;As of 1/10/06, returns POPUP as:
84 ; 1 if pt has any active flags, either Cat I or Cat II
85 ; 0 otherwise
86 N PRFARR
87 S POPUP=$S($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)
88 Q
89 ;
90GETFLG(ORY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID
91 I '$D(^TMP("ORPRF",$J,FLAGID)) Q
92 N IX,CNT
93 S (IX,CNT)=0
94 F S IX=$O(^TMP("ORPRF",$J,FLAGID,IX)) Q:'IX D
95 . S CNT=CNT+1,ORY(CNT)=$G(^TMP("ORPRF",$J,FLAGID,IX))
96 Q
97 ;
98CLEAR(ORY) ;Clear up the temp global
99 K ^TMP("ORPRF",$J)
100 Q
101 ;
Note: See TracBrowser for help on using the repository browser.