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

PXRMDLG.m

Go to the documentation of this file. 
  1. PXRMDLG ; SLC/PJH - Reminder Dialog Edit/Inquiry ;09/14/2009
  1.  ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
  1.  ;
  1.  ;Labels called from list 'PXRM DIALOG LIST'
  1.  ;
  1. EXIT ;Exit code
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  S VALMBCK="Q"
  1.  K ^TMP("PXRMDLG",$J)
  1.  K ^TMP("PXRMDLG4",$J)
  1.  Q
  1.  ;
  1. HDR ; Header code
  1.  S VALMHDR(1)=PXRMHD
  1.  S VALMHDR(2)=""
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  Q
  1.  ;
  1. HELP ;Help code
  1.  N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="GDLG"
  1.  D EN^VALM("PXRM DIALOG MAIN HELP")
  1.  Q
  1.  ;
  1. INIT ;Init
  1.  S VALMCNT=0
  1.  ;Delete any sequence numbers without dialogs
  1.  D CHECK
  1.  ;Load details of dialog
  1.  D BUILD(0)
  1.  Q
  1.  ;
  1. PEXIT ;PXRM DIALOG MENU protocol exit code
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  ;Reset after page up or down
  1.  D XQORM
  1.  Q
  1.  ;
  1.  ;Other Subroutines
  1.  ;
  1. BUILD(INP) ;Build workfile (protocols PXRM DIALOG VIEW/LIST)
  1.  ;
  1.  ;Variable VIEW is set in the calling protocol
  1.  ;
  1.  ;0= DIALOG SUMMARY
  1.  ;1= DIALOG DETAILS
  1.  ;2= DIALOG TEXT
  1.  ;3= PROGRESS NOTE TEXT
  1.  ;4= INQUIRY (ALL FIELDS) - NO LISTMAN
  1.  ;5= DIALOG OVERVIEW
  1.  ;
  1.  N DNAM,DNAME,VIEW
  1.  S VIEW=INP,PXRMMODE=VIEW,VALMCNT=0,VALMBCK="R"
  1.  I VIEW=5 S VALMBG=1
  1.  K ^TMP("PXRMDLG",$J)
  1.  ;Headers
  1.  S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
  1.  I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)>0 D
  1.  .S DNAM=DNAM_" (Disabled)"
  1.  S PXRMHD="DIALOG NAME: "_DNAM
  1.  I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="R" D
  1.  .S PXRMHD="REMINDER "_PXRMHD
  1.  I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="G" D
  1.  .S PXRMHD="DIALOG GROUP NAME: "_DNAM
  1.  I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" D
  1.  .S PXRMHD=PXRMHD_" [NATIONAL] *LIMITED EDIT*"
  1.  D HDR
  1.  ;
  1.  N DATA,DGRP,DHED,FGLOB,FIEN,FITEM,FNAME,FNUM,FTYP,RESULT,RESNM
  1.  N NATIONAL,OIEN,ONAME,ONUM,PDIS,PIEN,PNAME,PTXT,PTYP,RIEN,RNAME,SEQ,SUB
  1.  ;Build list of finding items
  1.  N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
  1.  ;Check if nationalreminder dialog
  1.  S NATIONAL=0 S:$P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" NATIONAL=1
  1.  ;Detail view of national dialogs allows only findings to be mapped 
  1.  I VIEW=1,NATIONAL D ^PXRMDLG3,XQORM Q
  1.  ;Build Listman array
  1.  D ARRAY(PXRMDIEN)
  1.  Q
  1.  ;
  1. ARRAY(DIEN) ;Build Dialog Display in list manager
  1.  ;
  1.  N DNLOCK,NLINE,NODE,NSEL
  1.  S NLINE=0,NODE="PXRMDLG",NSEL=0
  1.  K ^TMP("PXRMDLG4",$J)
  1.  ;
  1.  S DNLOCK=$P($G(^PXRMD(801.41,DIEN,100)),U,4)
  1.  ;Group header
  1.  I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D
  1.  .D DLINE^PXRMDLG4(DIEN,"","",NODE)
  1.  ;Other components
  1.  D DETAIL^PXRMDLG4(DIEN,"",VIEW,NODE)
  1.  ;
  1.  ;Headers
  1.  N HDR2
  1.  I VIEW=0 S HDR2="Dialog Summary" I $G(VALMBG)="" S VALMBG=1
  1.  I VIEW=1 S HDR2="Detailed Display"
  1.  I VIEW=2 S HDR2="Dialog Text"
  1.  I VIEW=3 S HDR2="Progress Note Text"
  1.  I VIEW=5 S HDR2="Dialog Overview"
  1.  ;
  1.  ;Create headings
  1.  D CHGCAP^VALM("HEADER1","Item  Seq.")
  1.  D CHGCAP^VALM("HEADER2",HDR2)
  1.  D CHGCAP^VALM("HEADER3","")
  1.  ;
  1.  S VALMCNT=NLINE
  1.  S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
  1.  ;
  1.  D XQORM
  1.  Q
  1.  ;
  1. CHECK ;Search for sequence numbers with no dialog pointer
  1.  N CNT,DA,DCNT,DEL,DELTMP,IEN,NODE,SCNT,SEQ,SEQTMP,SNUM
  1.  S IEN=PXRMDIEN,DEL="",(CNT,DA,SCNT)=0
  1.  F  S DA=$O(^PXRMD(801.41,IEN,10,DA)) Q:+DA=0  S NODE=^PXRMD(801.41,IEN,10,DA,0) D
  1.  . I NODE'[U S CNT=CNT+1 S DELTMP(CNT)=DA
  1.  . I NODE[U S SCNT=SCNT+1 S SEQTMP($P($G(NODE),U),SCNT)=DA
  1.  ;I CNT>0 D DELBLANK(IEN,.DELTMP)
  1.  S (SNUM,SEQ)=0
  1.  F  S SEQ=$O(SEQTMP(SEQ)) Q:SEQ=""  D
  1.  .S DCNT=0 F  S SNUM=$O(SEQTMP(SEQ,SNUM)) Q:+SNUM=0  D
  1.  ..S DCNT=DCNT+1 I DCNT>1 S DELTMP(DCNT)=SEQTMP(SEQ,SNUM) S DEL="Y"
  1.  ;I DEL="Y" D DELBLANK(IEN,.DELTMP)
  1.  Q
  1.  ;
  1. DELBLANK(IEN,DELTMP) ;Delete dialog multiple entry if dialog missing
  1.  N NUM,DA
  1.  S DA(1)=IEN
  1.  S NUM=0
  1.  F  S NUM=$O(DELTMP(NUM)) Q:NUM=""  D 
  1.  . S DA=DELTMP(NUM) Q:'DA
  1.  . S DIK="^PXRMD(801.41,"_DA(1)_",10,"
  1.  . D ^DIK
  1.  K DIK
  1.  Q
  1.  ;
  1. DESC(FIEN) ;Finding description
  1.  ;Determine finding type
  1.  S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
  1.  S FITEM=$P(FIEN,";") Q:FITEM=""
  1.  ;Diagnosis POV
  1.  I FGLOB["ICD9" D  Q
  1.  .S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
  1.  .S FNAME=$P($G(@FGLOB),U,3)_" ["_FITEM_"]"
  1.  ;Procedure CPT
  1.  I FGLOB["ICPT" D  Q
  1.  .S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
  1.  .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
  1.  ;Quick order
  1.  I FGLOB["ORD(101.41" D  Q
  1.  .S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
  1.  .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
  1.  ;Short name for finding type
  1.  S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
  1.  S FNUM=" ["_FTYP_"("_FITEM_")]"
  1.  ;Long name
  1.  S FTYP=$G(DEF2(FTYP))
  1.  S FGLOB=U_FGLOB_FITEM_",0)"
  1.  S FNAME=$P($G(@FGLOB),U,1)
  1.  I FNAME="" S FNAME=$P($G(@FGLOB),U)
  1.  I FNAME]"" S FNAME=FNAME_FNUM Q
  1.  S FNAME=FITEM
  1.  Q
  1.  ;
  1. LIT(INP) ;Find description for dialog type
  1.  Q:INP="G" "Dialog group: "
  1.  Q:INP="F" "Forced value: "
  1.  Q:INP="P" "Prompt: "
  1.  Q:INP="E" "Dialog element: "
  1.  Q "???"
  1.  ;
  1. REMD ;Reminder Details
  1.  N ARRAY,SUB
  1.  ;Change listman headings
  1.  D CHGCAP^VALM("HEADER1","Reminder Inquiry")
  1.  D CHGCAP^VALM("HEADER2","")
  1.  D CHGCAP^VALM("HEADER3","")
  1.  ;Check if dialog is linked to a reminder
  1.  I 'PXRMITEM D  Q
  1.  .S ^TMP("PXRMDLG",$J,2,0)=" *This dialog is not linked to a reminder*"
  1.  ;Build array using print template
  1.  D REMVAR^PXRMINQ(.ARRAY,PXRMITEM)
  1.  ;Copy into Listman global
  1.  S SUB=0
  1.  F  S SUB=$O(ARRAY(SUB)) Q:'SUB  D
  1.  .S VALMCNT=SUB
  1.  .S ^TMP("PXRMDLG",$J,VALMCNT,0)=ARRAY(VALMCNT)
  1.  Q
  1.  ;
  1. SEL ;PXRM DIALOG SELECTION ITEM validation
  1.  N ERR,IEN,SEL
  1.  S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
  1.  ;Invalid selection
  1.  I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D  Q
  1.  .W !,SEL_" is not an existing item number" H 2
  1.  ;Valid selection
  1.  S IEN=$O(@VALMAR@("IDX",SEL,"")) Q:'IEN
  1.  ;Copy/Delete/Edit dialog element
  1.  D IND^PXRMDEDI(IEN,SEL)
  1.  Q
  1.  ;
  1. XQORM ;Protocol Menu reset
  1.  S XQORM("#")=$O(^ORD(101,"B","PXRM DIALOG SELECTION ITEM",0))
  1.  S XQORM("#")=XQORM("#")_U_"1:"_VALMCNT
  1.  S XQORM("A")="Select Item: "
  1.  I PXRMGTYP="DLGE" D
  1.  .N FMENU
  1.  .S FMENU=$O(^ORD(101,"B","PXRM DIALOG GROUP MENU",0))_";ORD(101,"
  1.  .I FMENU S XQORM("HIJACK")=FMENU
  1.  Q
  1.  ;
  1. XHLP(CALL) ;General help text routine.
  1.  N HTEXT
  1.  N DIWF,DIWL,DIWR,IC,X
  1.  S DIWF="C75",DIWL=0,DIWR=75
  1.  ;
  1.  I CALL=1 D
  1.  .S HTEXT(1)="Enter Yes to if you are adding a new sequence number or"
  1.  .S HTEXT(2)="dialog element to this reminder dialog."
  1.  K ^UTILITY($J,"W")
  1.  S IC=""
  1.  F  S IC=$O(HTEXT(IC)) Q:IC=""  D
  1.  . S X=HTEXT(IC)
  1.  . D ^DIWP
  1.  W !
  1.  S IC=0
  1.  F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D
  1.  . W !,^UTILITY($J,"W",0,IC,0)
  1.  K ^UTILITY($J,"W")
  1.  W !
  1.  Q