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