Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORPRF

ORPRF.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. FMT(ROOT,DBRSDATA,DGHIST) ; Format - Convert record flag data to displayable data
  1. ; Sets ^TMP("ORPRF",$J,NN) with flag data for multiple flags
  1. ; DBRSDATA - local array with DBRS data
  1. ; DGHIST - local array with PRF history records
  1. N IDX,IX,CNT,CURFLAG
  1. S (IDX,CNT)=0
  1. F S IDX=$O(ROOT(IDX)) Q:'IDX D
  1. . S ^TMP("ORPRF",$J,IDX,"FLAG")=$P($G(ROOT(IDX,"FLAG")),U,2)
  1. . S ^TMP("ORPRF",$J,IDX,"CATEGORY")=$P($G(ROOT(IDX,"CATEGORY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Name: "_$P($G(ROOT(IDX,"FLAG")),U,2)
  1. . I $D(ROOT(IDX,"NARR")) D
  1. . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
  1. . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Narrative: "
  1. . . S IX=0 F S IX=$O(ROOT(IDX,"NARR",IX)) Q:'IX D
  1. . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=$G(ROOT(IDX,"NARR",IX,0))
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=" "
  1. . ; -- Assignment Details:
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Type: "_$P($G(ROOT(IDX,"FLAGTYPE")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Flag Category: "_$P($G(ROOT(IDX,"CATEGORY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Assignment Status: "_"Active"
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Initial Assigned Date: "_$P($G(ROOT(IDX,"ASSIGNDT")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Approved by: "_$P($G(ROOT(IDX,"APPRVBY")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Next Review Date: "_$P($G(ROOT(IDX,"REVIEWDT")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Owner Site: "_$P($G(ROOT(IDX,"OWNER")),U,2)
  1. . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Originating Site: "_$P($G(ROOT(IDX,"ORIGSITE")),U,2)
  1. . ;DBRS data
  1. . I $O(DBRSDATA("BEHAVIORAL",0)) I $P($G(ROOT(IDX,"FLAG")),U,2)="BEHAVIORAL" D
  1. . . N ORDBRSC,ORZDBRSD
  1. . . S ORDBRSC=0 F S ORDBRSC=+$O(DBRSDATA("BEHAVIORAL",ORDBRSC)) Q:ORDBRSC=0 D
  1. . . . S ORZDBRSD=$G(DBRSDATA("BEHAVIORAL",ORDBRSC))
  1. . . . I $P(ORZDBRSD,U,1)']"" Q
  1. . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="DBRS number: "_$P(ORZDBRSD,U,1)
  1. . . . I $P(ORZDBRSD,U,2)]"" S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Other DBRS data: "_$P(ORZDBRSD,U,2)
  1. . ;check if any history for the PRF flag that is being processed now
  1. . S CURFLAG=$P($G(ROOT(IDX,"FLAG")),U,2)
  1. . I $O(DGHIST(CURFLAG,0)) D
  1. . . N ORPRFHCN,ORPRFHDA,ORPRFSIT,ORQUIT
  1. . . S ORPRFSIT="",ORQUIT=0
  1. . . S ORPRFHCN=0 F S ORPRFHCN=+$O(DGHIST(CURFLAG,ORPRFHCN)) Q:ORPRFHCN=0!(ORQUIT=1) D Q:ORQUIT=1
  1. . . . I $D(DGHIST(CURFLAG,ORPRFHCN)),ORPRFHCN>10 D Q:ORQUIT=1
  1. . . . . S ORQUIT=1
  1. . . . . S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="*** Additional information is in VistA ***"
  1. . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=""
  1. . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="History of Actions Taken:"
  1. . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="Date Action Site ID Site Name"
  1. . . . I ORPRFHCN=1 S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)="------------------------------------------------"
  1. . . . S ORPRFHDA=$G(DGHIST(CURFLAG,ORPRFHCN)) Q:ORPRFHDA=""
  1. . . . ;I ORPRFSIT'=$P(ORPRFHDA,U) S ORPRFSIT=$P(ORPRFHDA,U) S CNT=CNT+1,^TMP("ORPRF",$J,IDX,CNT)=ORPRFSIT_" changes:"
  1. . . . 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)
  1. K ROOT
  1. Q
  1. ;
  1. HASFLG(ORY,PTDFN) ;Does patient PTDFN has flags
  1. ; DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)
  1. ; Returns array ORY listing active assigned flags
  1. ; Array ORY has form:
  1. ; ORY(flagID) = flagID^flagname,CAT1
  1. ; where CAT1 is 1 if flag is cat 1, 0 if cat 2
  1. ; ORY = Num of items returned in array ORY = num of flags
  1. I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
  1. N IDY,PRFARR,CAT1
  1. K ^TMP("ORPRF",$J)
  1. S ORY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
  1. Q:'ORY
  1. ;
  1. N DBRSARR,PRFHIST
  1. ;ICR# 6874 - check if DG*5.3*951 installed and then call the API to get DBRS information
  1. I $T(GETDBRS^DGPFDBRS)'="" I $$GETDBRS^DGPFDBRS(PTDFN,.DBRSARR)
  1. ;get history records for active PRFs
  1. D ACTPRFHS^ORPRFHST(PTDFN,.PRFHIST)
  1. ;
  1. D FMT(.@("PRFARR"),.DBRSARR,.PRFHIST) ; Sets ^TMP("ORPRF"
  1. S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
  1. . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
  1. . S CAT1=0
  1. . I $G(^TMP("ORPRF",$J,IDY,"CATEGORY"))="I (NATIONAL)" S CAT1=1
  1. . S ORY(IDY)=ORY(IDY)_U_CAT1
  1. Q
  1. ;
  1. HASFLG1(ORY,PTDFN) ; Does patient PTDFN have **Cat I** flags
  1. ; Returns array ORY listing active assigned Cat I flags
  1. ; Array ORY has form:
  1. ; ORY(flagID) = flagID^flagname
  1. ; ORY = Num of Cat I flags
  1. ; If pt has no Cat I flags ORY = 0 and no flags are returned.
  1. ; Also calls FMT^ORPRF, which sets ^TMP("ORPRF" for Cat I flags
  1. ;
  1. I '$L($TEXT(GETACT^DGPFAPI)) S ORY=0 Q
  1. N FLAGID,PRFARR,CAT1CNT,ACTFLGS
  1. K ^TMP("ORPRF",$J)
  1. S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
  1. I 'ACTFLGS S ORY=0 Q
  1. S (FLAGID,CAT1CNT)=0
  1. F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D
  1. . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S CAT1CNT=CAT1CNT+1 Q
  1. . K PRFARR(FLAGID)
  1. I 'CAT1CNT S ORY=0 Q
  1. D FMT(.@("PRFARR"))
  1. S IDY=0 F S IDY=$O(^TMP("ORPRF",$J,IDY)) Q:'IDY D
  1. . S ORY(IDY)=IDY_U_$G(^TMP("ORPRF",$J,IDY,"FLAG"))
  1. S ORY=CAT1CNT
  1. Q
  1. ;
  1. HASCAT1(HASCAT1,PTDFN) ;Does patient have Category I flags (no arrays)
  1. ; Returns boolean HASCAT1 = 0 or 1
  1. ; Does NOT set arrays or TMP globals
  1. N FLAGID,PRFARR,ACTFLGS
  1. S (HASCAT1,FLAGID)=0
  1. S ACTFLGS=$$GETACT^DGPFAPI(PTDFN,"PRFARR") I 'ACTFLGS G HASCAT1X
  1. F S FLAGID=$O(PRFARR(FLAGID)) Q:'FLAGID D Q:HASCAT1
  1. . I $P($G(PRFARR(FLAGID,"CATEGORY"))," ")="I" S HASCAT1=1
  1. HASCAT1X ;
  1. Q
  1. ;
  1. TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection
  1. ; for patient PTDFN?
  1. ;As of 1/10/06, returns POPUP as:
  1. ; 1 if pt has any active flags, either Cat I or Cat II
  1. ; 0 otherwise
  1. N PRFARR
  1. S POPUP=$S($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)
  1. Q
  1. ;
  1. GETFLG(ORY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID
  1. I '$D(^TMP("ORPRF",$J,FLAGID)) Q
  1. N IX,CNT
  1. S (IX,CNT)=0
  1. F S IX=$O(^TMP("ORPRF",$J,FLAGID,IX)) Q:'IX D
  1. . S CNT=CNT+1,ORY(CNT)=$G(^TMP("ORPRF",$J,FLAGID,IX))
  1. Q
  1. ;
  1. CLEAR(ORY) ;Clear up the temp global
  1. K ^TMP("ORPRF",$J)
  1. Q
  1. ;