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

PXRMRESN.m

Go to the documentation of this file. 
  1. PXRMRESN ; SLC/PJH - Edit/Inquire resolution statuses ;03/17/2000
  1.  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1.  ;
  1. START N DIC,PXRMGTYP,PXRMHD,PXRMRESN,Y
  1.  ;Select reminder category for display
  1. SELECT ;General selection
  1.  S PXRMHD="Reminder Resolution Status",PXRMGTYP="RESN",PXRMRESN=""
  1.  D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMRESN")
  1.  ;Should return a value
  1.  I PXRMRESN D  G SELECT
  1.  .S PXRMHD="REMINDER RESOLUTION STATUS NAME:"
  1.  .;Listman option
  1.  .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMRESN)
  1.  ;
  1. END Q
  1.  ;
  1.  ;REMINDER RESOLUTION STATUSES #801.9
  1.  ;-----------------------------------
  1.  ;Temporary list of STATUSES
  1. DISP N CNT,CODE,DES,SUB,TXT
  1.  W #,"REMINDER RESOLUTION STATUS SELECTION",!
  1.  S CODE="",CNT=0
  1.  F  S CODE=$O(^PXRMD(801.9,"B",CODE)) Q:CODE=""  D
  1.  .S CNT=CNT+1
  1.  .W !,CODE
  1.  W !
  1.  Q
  1.  ;
  1.  ;Build display for selected status - Called from PXRMGEN
  1.  ;---------------------------------------------------------
  1. RESN(PXRMRESN) ;
  1.  N DATA,DARRAY,SUB
  1.  S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
  1.  ;
  1.  ;Format headings to include resolution name
  1.  S HEADER=PXRMHD_" "_$P(^PXRMD(801.9,PXRMRESN,0),U)
  1.  ;
  1.  ;Build Reminder Resolution Status Display
  1.  D BUILD(.DARRAY,PXRMRESN) M ^TMP("PXRMGENS",$J)=DARRAY
  1.  ; 
  1.  ;Put the list into the array List Manager is using.
  1.  S SUB=""
  1.  S VALMCNT=0
  1.  F  S SUB=$O(^TMP("PXRMGENS",$J,SUB)) Q:SUB=""  D
  1.  .S DATA=$G(^TMP("PXRMGENS",$J,SUB))
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=DATA
  1.  S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  K ^TMP("PXRMGENS",$J)
  1.  ;Create headings
  1.  D CHGCAP^VALM("HEADER1","")
  1.  D CHGCAP^VALM("HEADER2","")
  1.  D CHGCAP^VALM("HEADER3","")
  1.  Q
  1.  ;
  1.  ;Build Resolution Status Inquiry array
  1.  ;-------------------------------------
  1. BUILD(ARRAY,D0) ;
  1.  N DIWF,DIWL,DIWR,IC,SUB,TAB,TXT,X
  1.  N ABBR,COL,CREA,DATA,DESC,FOUND,INACT,REST
  1.  S DIWF="C70",DIWL=0,DIWR=70,IC=0
  1.  K ^UTILITY($J,"W")
  1.  ;Get Resolution status details
  1.  S DATA=$G(^PXRMD(801.9,D0,0))
  1.  S DESC=$P(DATA,U),ABBR=$P(DATA,U,2),COL=$P(DATA,U,3),INACT=$P(DATA,U,4)
  1.  S CREA=$P(DATA,U,5),REST=$P(DATA,U,6)
  1.  ;
  1.  ;Resolution Status
  1.  S TXT="Resolution Status: "_DESC
  1.  ;Restricted edit is same as National
  1.  S:REST TXT="National "_TXT D SET(0,TXT,1)
  1.  ;
  1.  S TXT="Resolution Status Description" D SET(0,TXT,0)
  1.  ;Get Resolution Status description
  1.  S SUB=0,TAB=0,FOUND=0
  1.  F  S SUB=$O(^PXRMD(801.9,D0,1,SUB)) Q:SUB=""  D
  1.  .S X=$G(^PXRMD(801.9,D0,1,SUB,0))
  1.  .D ^DIWP
  1.  F  S SUB=$O(^UTILITY($J,"W",0,SUB)) Q:SUB=""  D
  1.  .D SET(5,^UTILITY($J,"W",0,SUB,0),0) S FOUND=1
  1.  K ^UTILITY($J,"W")
  1.  ;Display no description message
  1.  I 'FOUND S TXT="*NONE*" D SET(5,TXT,0)
  1.  D SET(0,"",1)
  1.  ;
  1.  ;Related National Status from cross reference
  1.  I 'REST D
  1.  .;Get national code from cross reference
  1.  .N IEN S IEN=$O(^PXRMD(801.9,"AC",D0,""))
  1.  .;If none allocated say so
  1.  .I 'IEN S TXT="***UNDEFINED***"
  1.  .;Get name of national status and display
  1.  .I IEN S TXT=$P($G(^PXRMD(801.9,IEN,0)),U)
  1.  .S TXT="Related National Status:  "_TXT D SET(3,TXT,0)
  1.  ;
  1.  ;Abbreviated Name
  1.  S TXT="Abbreviated name:  "_ABBR D SET(10,TXT,0)
  1.  ;Report Column Headings
  1.  S TXT="Report Column Headings:  "_ABBR D SET(4,TXT,0)
  1.  ;Inactive flag
  1.  S TXT="Inactive Flag:  "_$S(INACT:"INACTIVE",1:"") D SET(13,TXT,0)
  1.  ;Creator for local codes
  1.  I CREA,'REST D
  1.  .S TXT="Creator:  "_$$GET1^DIQ(200,CREA,.01) D SET(19,TXT,0)
  1.  ;Local Resolution Statuses
  1.  I REST D
  1.  .N LARRAY,LIEN S SUB=0,FOUND=0
  1.  .F  S SUB=$O(^PXRMD(801.9,D0,10,SUB)) Q:'SUB  D
  1.  ..S LIEN=$P($G(^PXRMD(801.9,D0,10,SUB,0)),U)
  1.  ..I LIEN S LARRAY(LIEN)="",FOUND=1
  1.  .S TXT="Local Resolution Statuses:" D SET(0,"",1),SET(0,TXT,0)
  1.  .I 'FOUND S TXT="*NONE*" D SET(5,TXT,0) Q 
  1.  .S LIEN="" F  S LIEN=$O(LARRAY(LIEN)) Q:'LIEN  D
  1.  ..S TXT=$P($G(^PXRMD(801.9,LIEN,0)),U) D SET(4,TXT,0)
  1.  Q
  1.  ;
  1.  ;Save local array
  1.  ;----------------
  1. SET(TAB,TXT,LF) ;
  1.  ;Save main line
  1.  S IC=IC+1,ARRAY(IC)=$J("",TAB)_TXT
  1.  ;Additional line feeds
  1.  I LF D
  1.  .N CNT F CNT=1:1:LF S IC=IC+1,ARRAY(IC)=$J("",79)
  1.  Q