PXRMDLG6 ; SLC/AGP - Reminder Dialog Edit/Inquiry ;07/24/2013
;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
;
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=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
Q +RESULT
;
OKTODEL(DIEN) ;
;this checks to see if an entry is okay to delete. the entry
;cannot be used anywhere else.
;"AD" for component multiple
;"R" 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,"R",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
;
PXRMDLG6 ; SLC/AGP - Reminder Dialog Edit/Inquiry ;07/24/2013
+1 ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
+2 ;
ISACTDLG(DIEN) ;
+1 ;this returns a 1 if the dialog can be used in a TIU Template
+2 NEW NODE
+3 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+4 IF $PIECE(NODE,U,4)'="R"
QUIT 0
+5 IF +$PIECE(NODE,U,3)>0
QUIT 0
+6 QUIT 1
+7 ;
DISCKINP(DIEN,X,ORG) ;
+1 ;sub script 1 = name field
+2 ;sub script 2 = disable field
+3 ;
+4 IF X(1)=""
QUIT 1
+5 IF $GET(PXRMINST)=1
QUIT 1
+6 IF X(2)=1!(X(2)=2)
QUIT 1
+7 ;
+8 NEW CANACT,CNT,CNT1,MSG,NAME,RESULT,TEXT,TYPE,STDFILES
+9 DO DIALDSAR^PXRMFRPT(.STDFILES)
IF '$DATA(STDFILES)
QUIT 1
+10 SET TYPE=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
+11 IF "RFPT"[TYPE
QUIT 1
+12 SET TYPE=$SELECT(TYPE="E":"Element",TYPE="G":"Group",TYPE="S":"Result Group")
+13 SET RESULT=$$DISABCHK(DIEN,.STDFILES,.MSG)
+14 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+15 SET CNT1=1
+16 IF RESULT=0
Begin DoDot:1
+17 SET TEXT(CNT1)="Disabled value cannot be changed."
+18 SET $PIECE(^PXRMD(801.41,DIEN,0),U,3)=ORG(2)
End DoDot:1
+19 IF $DATA(MSG)>0
Begin DoDot:1
+20 SET CNT=0
FOR
SET CNT=$ORDER(MSG(CNT))
IF CNT'>0
QUIT
SET CNT1=CNT1+1
SET TEXT(CNT1)=MSG(CNT)
+21 DO EN^DDIOL(.TEXT)
End DoDot:1
+22 QUIT RESULT
+23 ;
DISABCHK(DIEN,STDFILES,MSG) ;
+1 ;
+2 NEW CNT,FILE,FILESTAT,FIND,NODE,IEN,RESULT,STATUS,VPTR
+3 SET RESULT=1
SET CNT=0
+4 SET NODE=$GET(^PXRMD(801.41,DIEN,1))
+5 ;;Check for MH Test only in Result Groups
+6 IF $DATA(STDFILES("^YTT(601.71,"))>0
Begin DoDot:1
+7 SET FILESTAT=$PIECE(STDFILES("YTT(601.71,"),U,2)
+8 SET IEN=$PIECE($GET(^PXRMD(801.41,DIEN,50)),U)
+9 SET STATUS=$$ENSTAT(STDFILES("^YTT(601.71,"),IEN)
+10 IF STATUS=0
DO DSMSG(.MSG,.CNT,"MH Test",IEN,"^YTT(601.71)")
IF FILESTAT=6
SET RESULT=0
End DoDot:1
+11 ;
+12 ;Check for Orderable Items
+13 IF $DATA(STDFILES("^ORD(101.43,"))>0
Begin DoDot:1
+14 SET FILESTAT=$PIECE(STDFILES("^ORD(101.43,"),U,2)
+15 SET IEN=$PIECE(NODE,U,7)
+16 SET STATUS=$$ENSTAT(STDFILES("^ORD(101.43,"),IEN)
+17 IF STATUS=0
DO DSMSG(.MSG,.CNT,"Orderable Item",IEN,"^ORD(101.43)")
IF FILESTAT=6
SET RESULT=0
End DoDot:1
+18 ;
+19 ;Check for Finding Items
+20 SET FIND=$PIECE(NODE,U,5)
+21 SET IEN=$PIECE(FIND,";")
SET FILE=$PIECE(FIND,";",2)
+22 IF $DATA(STDFILES(U_FILE))>0
Begin DoDot:1
+23 SET FILESTAT=$PIECE(STDFILES(U_FILE),U,2)
+24 SET STATUS=$$ENSTAT(STDFILES(U_FILE),IEN)
+25 IF STATUS=0
DO DSMSG(.MSG,.CNT,"Finding Item",IEN,$$SETGBL^PXRMDLG5(FILE))
IF FILESTAT=6
SET RESULT=0
End DoDot:1
+26 ;
+27 ;Check for additional finding items
+28 SET FIND=0
FOR
SET FIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",FIND))
IF FIND=""
QUIT
Begin DoDot:1
+29 SET IEN=$PIECE(FIND,";")
SET FILE=$PIECE(FIND,";",2)
+30 IF $DATA(STDFILES(U_FILE))>0
Begin DoDot:2
+31 SET FILESTAT=$PIECE(STDFILES(U_FILE),U,2)
+32 SET STATUS=$$ENSTAT(STDFILES(U_FILE),IEN)
+33 IF STATUS=0
DO DSMSG(.MSG,.CNT,"Additional Finding Item",IEN,$$SETGBL^PXRMDLG5(FILE))
IF FILESTAT=6
SET RESULT=0
End DoDot:2
End DoDot:1
+34 QUIT RESULT
+35 ;
DSMSG(MSG,CNT,FIELD,IEN,GBL) ;
+1 NEW ENTRY
+2 SET CNT=CNT+1
+3 SET ENTRY=$PIECE($GET(@GBL@(IEN,0)),U)
+4 SET MSG(CNT)=" "_FIELD_" entry "_ENTRY_" is inactive."
+5 QUIT
+6 ;
ENSTAT(FILENUM,IEN) ;
+1 ;Return values 0 if finding is inactive, return 1 if finding is active
+2 NEW FIENS,STATUS
+3 SET FIENS=IEN_","
+4 ;DBIA #4631
+5 SET STATUS=$PIECE($$GETSTAT^XTID(FILENUM,.01,FIENS),U,1)
+6 QUIT STATUS
+7 ;
FILESCR(IEN,FILENUM,DA) ;
+1 NEW DTYPE,LOCK,RESULT,STATUS
+2 IF $GET(PXRMINST)=1
QUIT 1
+3 SET RESULT=1
+4 ;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
+5 ;DBIA #4640
+6 SET STATUS=+$$GETSTAT^HDISVF01(FILENUM)
+7 SET LOCK=$SELECT(STATUS=6:1,STATUS=7:1,1:0)
+8 IF LOCK=1
SET RESULT=$PIECE($$GETSTAT^XTID(FILENUM,.01,IEN_","),U,1)
+9 IF +RESULT=0
QUIT +RESULT
+10 IF FILENUM=9999999.64
IF $PIECE($GET(^AUTTHF(IEN,0)),U,10)="C"
SET RESULT=0
+11 IF FILENUM=601.71
IF $$MH^PXRMDLG5(IEN)=0
SET RESULT=0
+12 ;if a taxonomy does not have codes marked for use in a dialog then do
+13 ;not allow a selection
+14 IF FILENUM=811.2
Begin DoDot:1
+15 IF '$DATA(^PXD(811.2,IEN,20,"AUID"))
SET RESULT=-1
+16 IF $PIECE($GET(^PXD(811.2,IEN,0)),U,6)=1
SET RESULT=0
End DoDot:1
+17 QUIT +RESULT
+18 ;
OKTODEL(DIEN) ;
+1 ;this checks to see if an entry is okay to delete. the entry
+2 ;cannot be used anywhere else.
+3 ;"AD" for component multiple
+4 ;"R" for replacement element/groups
+5 ;"RG" for result groups
+6 ;
+7 IF $GET(PXRMEXCH)=1
QUIT 1
+8 IF $DATA(^PXRMD(801.41,"AD",DIEN))
QUIT 0
+9 IF $DATA(^PXRMD(801.41,"R",DIEN))
QUIT 0
+10 IF $DATA(^PXRMD(801.41,"RG",DIEN))
QUIT 0
+11 QUIT 1
+12 ;
PIPECHK(DIEN) ;
+1 NEW AMOUNT,CNT,FLDNAM,NODE,NUM,TYPE
+2 SET TYPE=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
+3 FOR NODE=25,35
Begin DoDot:1
+4 SET CNT=0
SET NUM=0
+5 FOR
SET NUM=$ORDER(^PXRMD(801.41,DIEN,NODE,NUM))
IF NUM'>0
QUIT
Begin DoDot:2
+6 SET AMOUNT=$LENGTH(^PXRMD(801.41,DIEN,NODE,NUM,0),"|")
IF AMOUNT=1
QUIT
+7 SET CNT=CNT+(AMOUNT-1)
+8 IF CNT=0
QUIT
+9 IF CNT#2=0
QUIT
+10 IF TYPE="E"
SET FLDNAM=$SELECT(NODE=25:"Dialog/Progress Note Text",1:"Alternate Progress Note Text")
+11 IF TYPE="G"
SET FLDNAM=$SELECT(NODE=25:"Group Header Dialog Text",1:"Group Header Alternate Progress Note Text")
+12 DO TIUOBJW^PXRMFNFT(FLDNAM,CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
