- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRF.m
r613 r623 1 ORPRF ;SLC/JLI-Patient record flag ;6/14/06 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215,243**;Dec 17, 1997;Build 242 3 ; 4 FMT(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 ; 30 HASFLG(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,CAT1 35 ; where CAT1 is 1 if flag is cat 1, 0 if cat 2 36 ; ORY = Num of items returned in array ORY = num of flags 37 I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q 38 N IDY,PRFARR,CAT1 39 K ^TMP("ORPRF",$J) 40 S ORY=$$GETACT^DGPFAPI(PTDFN,"PRFARR") 41 Q:'ORY 42 D FMT(.@("PRFARR")) ; Sets ^TMP("ORPRF" 43 S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D 44 . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG")) 45 . S CAT1=0 46 . I $G(^TMP("ORPRF",$J,IDY,"CATEGORY"))="I (NATIONAL)" S CAT1=1 47 . S ORY(IDY)=ORY(IDY)_U_CAT1 48 Q 49 ; 50 HASFLG1(ORY,PTDFN) ; Does patient PTDFN have **Cat I** flags 51 ; Returns array ORY listing active assigned Cat I flags 52 ; Array ORY has form: 53 ; ORY(flagID) = flagID^flagname 54 ; ORY = Num of Cat I flags 55 ; If pt has no Cat I flags ORY = 0 and no flags are returned. 56 ; Also calls FMT^ORPRF, which sets ^TMP("ORPRF" for Cat I flags 57 ; 58 I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q 59 N FLAGID,PRFARR,CAT1CNT,ACTFLGS 60 K ^TMP("ORPRF",$J) 61 S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR") 62 I 'ACTFLGS S ORY=0 Q 63 S (FLAGID,CAT1CNT)=0 64 F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D 65 . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S CAT1CNT=CAT1CNT+1 Q 66 . K PRFARR(FLAGID) 67 I 'CAT1CNT S ORY=0 Q 68 D FMT(.@("PRFARR")) 69 S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D 70 . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG")) 71 S ORY=CAT1CNT 72 Q 73 ; 74 HASCAT1(HASCAT1,PTDFN) ;Does patient have Category I flags (no arrays) 75 ; Returns boolean HASCAT1 = 0 or 1 76 ; Does NOT set arrays or TMP globals 77 N FLAGID,PRFARR,ACTFLGS 78 S (HASCAT1,FLAGID)=0 79 S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR") I 'ACTFLGS G HASCAT1X 80 F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D Q:HASCAT1 81 . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S HASCAT1=1 82 HASCAT1X ; 83 Q 84 ; 85 TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection 86 ; for patient PTDFN? 87 ;As of 1/10/06, returns POPUP as: 88 ; 1 if pt has any active flags, either Cat I or Cat II 89 ; 0 otherwise 90 N PRFARR 91 S POPUP=$S($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0) 92 Q 93 ; 94 GETFLG(ORY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID 95 I '$D(^TMP("ORPRF",$J,FLAGID)) Q 96 N IX,CNT 97 S (IX,CNT)=0 98 F S IX=$O(^TMP("ORPRF",$J,FLAGID,IX)) Q:'IX D 99 . S CNT=CNT+1,ORY(CNT)=$G(^TMP("ORPRF",$J,FLAGID,IX)) 100 Q 101 ; 102 CLEAR(ORY) ;Clear up the temp global 103 K ^TMP("ORPRF",$J) 104 Q 105 ; 1 ORPRF ;SLC/JLI-Patient record flag ;1/10/06 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**173,187,190,215**;Dec 17, 1997 3 ; 4 FMT(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 ; 30 HASFLG(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 ; 46 HASFLG1(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 ; 70 HASCAT1(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 78 HASCAT1X ; 79 Q 80 ; 81 TRIGRPOP(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 ; 90 GETFLG(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 ; 98 CLEAR(ORY) ;Clear up the temp global 99 K ^TMP("ORPRF",$J) 100 Q 101 ;
Note:
See TracChangeset
for help on using the changeset viewer.
