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

PXRMDLG6.m

Go to the documentation of this file. 
  1. PXRMDLG6 ; SLC/AGP - Reminder Dialog Edit/Inquiry ;07/24/2013
  1.  ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
  1.  ;
  1. ISACTDLG(DIEN) ;
  1.  ;this returns a 1 if the dialog can be used in a TIU Template
  1.  N NODE
  1.  S NODE=$G(^PXRMD(801.41,DIEN,0))
  1.  I $P(NODE,U,4)'="R" Q 0
  1.  I +$P(NODE,U,3)>0 Q 0
  1.  Q 1
  1.  ;
  1. DISCKINP(DIEN,X,ORG) ;
  1.  ;sub script 1 = name field
  1.  ;sub script 2 = disable field
  1.  ;
  1.  I X(1)="" Q 1
  1.  I $G(PXRMINST)=1 Q 1
  1.  I X(2)=1!(X(2)=2) Q 1
  1.  ;
  1.  N CANACT,CNT,CNT1,MSG,NAME,RESULT,TEXT,TYPE,STDFILES
  1.  D DIALDSAR^PXRMFRPT(.STDFILES) I '$D(STDFILES) Q 1
  1.  S TYPE=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
  1.  I "RFPT"[TYPE Q 1
  1.  S TYPE=$S(TYPE="E":"Element",TYPE="G":"Group",TYPE="S":"Result Group")
  1.  S RESULT=$$DISABCHK(DIEN,.STDFILES,.MSG)
  1.  S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  S CNT1=1
  1.  I RESULT=0 D 
  1.  .S TEXT(CNT1)="Disabled value cannot be changed."
  1.  .S $P(^PXRMD(801.41,DIEN,0),U,3)=ORG(2)
  1.  I $D(MSG)>0 D
  1.  .S CNT=0 F  S CNT=$O(MSG(CNT)) Q:CNT'>0  S CNT1=CNT1+1,TEXT(CNT1)=MSG(CNT)
  1.  .D EN^DDIOL(.TEXT)
  1.  Q RESULT
  1.  ;
  1. DISABCHK(DIEN,STDFILES,MSG) ;
  1.  ;
  1.  N CNT,FILE,FILESTAT,FIND,NODE,IEN,RESULT,STATUS,VPTR
  1.  S RESULT=1,CNT=0
  1.  S NODE=$G(^PXRMD(801.41,DIEN,1))
  1.  ;;Check for MH Test only in Result Groups
  1.  I $D(STDFILES("^YTT(601.71,"))>0 D
  1.  .S FILESTAT=$P(STDFILES("YTT(601.71,"),U,2)
  1.  .S IEN=$P($G(^PXRMD(801.41,DIEN,50)),U)
  1.  .S STATUS=$$ENSTAT(STDFILES("^YTT(601.71,"),IEN)
  1.  .I STATUS=0 D DSMSG(.MSG,.CNT,"MH Test",IEN,"^YTT(601.71)") I FILESTAT=6 S RESULT=0
  1.  ;
  1.  ;Check for Orderable Items
  1.  I $D(STDFILES("^ORD(101.43,"))>0 D
  1.  .S FILESTAT=$P(STDFILES("^ORD(101.43,"),U,2)
  1.  .S IEN=$P(NODE,U,7)
  1.  .S STATUS=$$ENSTAT(STDFILES("^ORD(101.43,"),IEN)
  1.  .I STATUS=0 D DSMSG(.MSG,.CNT,"Orderable Item",IEN,"^ORD(101.43)") I FILESTAT=6 S RESULT=0
  1.  ;
  1.  ;Check for Finding Items
  1.  S FIND=$P(NODE,U,5)
  1.  S IEN=$P(FIND,";"),FILE=$P(FIND,";",2)
  1.  I $D(STDFILES(U_FILE))>0 D
  1.  .S FILESTAT=$P(STDFILES(U_FILE),U,2)
  1.  .S STATUS=$$ENSTAT(STDFILES(U_FILE),IEN)
  1.  .I STATUS=0 D DSMSG(.MSG,.CNT,"Finding Item",IEN,$$SETGBL^PXRMDLG5(FILE)) I FILESTAT=6 S RESULT=0
  1.  ;
  1.  ;Check for additional finding items
  1.  S FIND=0 F  S FIND=$O(^PXRMD(801.41,DIEN,3,"B",FIND)) Q:FIND=""  D
  1.  .S IEN=$P(FIND,";"),FILE=$P(FIND,";",2)
  1.  .I $D(STDFILES(U_FILE))>0 D
  1.  ..S FILESTAT=$P(STDFILES(U_FILE),U,2)
  1.  ..S STATUS=$$ENSTAT(STDFILES(U_FILE),IEN)
  1.  ..I STATUS=0 D DSMSG(.MSG,.CNT,"Additional Finding Item",IEN,$$SETGBL^PXRMDLG5(FILE)) I FILESTAT=6 S RESULT=0
  1.  Q RESULT
  1.  ;
  1. DSMSG(MSG,CNT,FIELD,IEN,GBL) ;
  1.  N ENTRY
  1.  S CNT=CNT+1
  1.  S ENTRY=$P($G(@GBL@(IEN,0)),U)
  1.  S MSG(CNT)="   "_FIELD_" entry "_ENTRY_" is inactive."
  1.  Q
  1.  ;
  1. ENSTAT(FILENUM,IEN) ;
  1.  ;Return values 0 if finding is inactive, return 1 if finding is active
  1.  N FIENS,STATUS
  1.  S FIENS=IEN_","
  1.  ;DBIA #4631
  1.  S STATUS=$P($$GETSTAT^XTID(FILENUM,.01,FIENS),U,1)
  1.  Q STATUS
  1.  ;
  1. FILESCR(IEN,FILENUM,DA) ;
  1.  N DTYPE,LOCK,RESULT,STATUS
  1.  I $G(PXRMINST)=1 Q 1
  1.  S RESULT=1
  1.  ;I FILENUM=811.2,$G(DA)>0,$P($G(^PXRMD(801.41,DA,0)),U,4)="G" W !,"Cannot add a taxonomy as finding item to a group." Q 0
  1.  ;DBIA #4640
  1.  S STATUS=+$$GETSTAT^HDISVF01(FILENUM)
  1.  S LOCK=$S(STATUS=6:1,STATUS=7:1,1:0)
  1.  I LOCK=1 S RESULT=$P($$GETSTAT^XTID(FILENUM,.01,IEN_","),U,1)
  1.  I +RESULT=0 Q +RESULT
  1.  I FILENUM=9999999.64,$P($G(^AUTTHF(IEN,0)),U,10)="C" S RESULT=0
  1.  I FILENUM=601.71,$$MH^PXRMDLG5(IEN)=0 S RESULT=0
  1.  ;if a taxonomy does not have codes marked for use in a dialog then do
  1.  ;not allow a selection
  1.  I FILENUM=811.2 D
  1.  .I '$D(^PXD(811.2,IEN,20,"AUID")) S RESULT=-1
  1.  .I $P($G(^PXD(811.2,IEN,0)),U,6)=1 S RESULT=0
  1.  Q +RESULT
  1.  ;
  1. OKTODEL(DIEN) ;
  1.  ;this checks to see if an entry is okay to delete. the entry
  1.  ;cannot be used anywhere else.
  1.  ;"AD" for component multiple
  1.  ;"R" for replacement element/groups
  1.  ;"RG" for result groups
  1.  ;
  1.  I $G(PXRMEXCH)=1 Q 1
  1.  I $D(^PXRMD(801.41,"AD",DIEN)) Q 0
  1.  I $D(^PXRMD(801.41,"R",DIEN)) Q 0
  1.  I $D(^PXRMD(801.41,"RG",DIEN)) Q 0
  1.  Q 1
  1.  ;
  1. PIPECHK(DIEN) ;
  1.  N AMOUNT,CNT,FLDNAM,NODE,NUM,TYPE
  1.  S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1.  F NODE=25,35 D
  1.  .S CNT=0,NUM=0
  1.  .F  S NUM=$O(^PXRMD(801.41,DIEN,NODE,NUM)) Q:NUM'>0  D
  1.  ..S AMOUNT=$L(^PXRMD(801.41,DIEN,NODE,NUM,0),"|") I AMOUNT=1 Q
  1.  ..S CNT=CNT+(AMOUNT-1)
  1.  ..I CNT=0 Q
  1.  ..I CNT#2=0 Q
  1.  ..I TYPE="E" S FLDNAM=$S(NODE=25:"Dialog/Progress Note  Text",1:"Alternate Progress Note Text")
  1.  ..I TYPE="G" S FLDNAM=$S(NODE=25:"Group Header Dialog Text",1:"Group Header Alternate Progress Note Text")
  1.  ..D TIUOBJW^PXRMFNFT(FLDNAM,CNT)
  1.  Q
  1.  ;