PXRMOCR ;SLC/PKR - Routines for editing order check rules ;03/17/2016 11:37
;;2.0;CLINICAL REMINDERS;**22,45**;Feb 04, 2005;Build 566
;Also contains routines used by the DD for file #801.1.
;=============================================
CHECK(IEN,DDSBR,DDSERROR) ;Check a rule for errors, called by DATA
;VALIDATION on form.
N CHKTXT,DEF,DEFOUT,OCTEXT,TERM,TEXT
;Either a term or definition must be defined.
S TERM=$$GET^DDSVAL(801.1,IEN,20)
S DEF=$$GET^DDSVAL(801.1,IEN,30)
S CHKTXT=1
I TERM="",DEF="" D Q
. S CHKTXT=0
. S TEXT="Either a term or defintion must be defined."
. S DDSERROR=1
. S DDSBR="TERM^PXRM OCR MAIN BLOCK^1"
. I $D(DDS) D HLP^DDSUTL(TEXT)
. E D EN^DDIOL(TEXT)
I (TERM'=""),($$GET^DDSVAL(801.1,IEN,21)="") D Q
. S CHKTXT=0
. S TEXT="The TERM EVALUATION STATUS is missing."
. S DDSERROR=1
. S DDSBR="TERM EVALUATION STATUS^PXRM OCR TERM^20"
. I $D(DDS) D MSG^DDSUTL(TEXT)
. E D EN^DDIOL(TEXT)
I (DEF'=""),($$GET^DDSVAL(801.1,IEN,31)="") D Q
. S CHKTXT=0
. S TEXT="The DEFINITION EVALUATION STATUS is missing."
. S DDSERROR=1
. S DDSBR="DEFINITION EVALUATION STATUS^PXRM OCR DEFINITION^30"
. I $D(DDS) D MSG^DDSUTL(TEXT)
. E D EN^DDIOL(TEXT)
S DEFOUT=$$GET^DDSVAL(801.1,IEN,32)
I (DEF'=""),(DEFOUT="") D Q
. S CHKTXT=0
. S TEXT="The OUTPUT TEXT is missing."
. S DDSERROR=1
. S DDSBR="OUTPUT TEXT^PXRM OCR DEFINITION^30"
. I $D(DDS) D MSG^DDSUTL(TEXT)
. E D EN^DDIOL(TEXT)
I TERM=""&(DEF=""&(DEFOUT="D")) Q
S OCTEXT=$$GET^DDSVAL(801.1,IEN,"ORDER CHECK TEXT")
I CHKTXT=1,$$WPNCHAR^PXRMSMAN(OCTEXT)=0 D Q
. S TEXT="There is no ORDER CHECK TEXT."
. S DDSERROR=1
. S DDSBR="ORDER CHECK TEXT^PXRM OCR MAIN BLOCK^1"
. I $D(DDS) D MSG^DDSUTL(TEXT)
. E D EN^DDIOL(TEXT)
D FOCTXT(IEN,OCTEXT,.DDSBR,.DDSERROR)
Q
;
;=============================================
DCAP(IEN) ;This is the executable caption for the definition.
I '$$DEDOK(IEN) Q ""
N DIEN
S DIEN=$$GET^DDSVAL(801.1,IEN,"REMINDER DEFINITION")
I DIEN="" Q "DEFINITION: "
Q "DEFINITION: "_$P(^PXD(811.9,DIEN,0),U,1)
;
;=============================================
DDEL(IEN,OLD,NEW) ;Kill logic for AD cross-reference.
I $G(NEW)>0 Q
D DELFIELD(IEN,31)
D DELFIELD(IEN,32)
Q
;
;=============================================
DEDOK(IEN) ;The definition in a rule can be edited as long as a term has
;not been defined.
I $$GET^DDSVAL(801.1,IEN,"REMINDER TERM")="" Q 1
Q 0
;
;===================================
DELFIELD(IEN,FIELD) ;Delete a field.
N FDA,IENS,MSG
S IENS=IEN_","
S FDA(801.1,IENS,FIELD)="@"
D FILE^DIE("","FDA","MSG")
Q
;
;=============================================
DPOST(IEN) ;Definition post-action.
;If the definition is defined do not allow navigation to the term.
N VALUE
S VALUE=$S($$TEDOK(IEN):0,1:1)
D UNED^DDSUTL("TERM","PXRM OCR MAIN BLOCK",1,VALUE)
Q
;
;=============================================
FOCTXT(IEN,OCTEXT,DDSBR,DDSERROR) ;Format and store the order check text as
;long as it does not contain a TIU object.
N FDA,IENS,IND,MSG,NIN,NOUT,NPIPE,TEXTIN,TEXTOUT
S NIN=$P(@OCTEXT@(0),U,4)
S NPIPE=0
F IND=1:1:NIN D
. S TEXTIN(IND)=@OCTEXT@(IND,0)
. S NPIPE=NPIPE+$L(TEXTIN(IND),"|")-1
S $P(^PXD(801.1,IEN,5),U,1)=NIN
;Remove existing formatted text.
K ^PXD(801.1,IEN,6) S $P(^PXD(801.1,IEN,5),U,2)=0
I NPIPE=0 D Q
.;No TIU Objects, format and save the text.
. D FORMAT^PXRMTEXT(1,80,NIN,.TEXTIN,.NOUT,.TEXTOUT)
. S $P(^PXD(801.1,IEN,5),U,2)=NOUT
. S IENS=IEN_","
. S FDA(801.1,IENS,47)="TEXTOUT"
. D UPDATE^DIE("","FDA","","MSG")
I (NPIPE#2)=1 D
.;There is an odd number of pipes.
. S TEXTOUT(1)="Warning, the Order Check Text has "_NPIPE_" '|' characters."
. S TEXTOUT(2)="Because this is an odd number, TIU Object expansion will not work."
. S DDSERROR=1
. S DDSBR="ORDER CHECK TEXT^PXRM OCR MAIN BLOCK^1"
. I $D(DDS) D MSG^DDSUTL(.TEXTOUT)
. E D EN^DDIOL(.TEXTOUT)
Q
;
;=============================================
FORMPRE(IEN) ;Form pre-action.
;If the term is defined, do not allow navigation to the definition.
N VALUE
S VALUE=$S($$DEDOK(IEN):0,1:1)
D UNED^DDSUTL("DEFINITION","PXRM OCR MAIN BLOCK",1,VALUE)
;If the definition is defined do not allow navigation to the term.
S VALUE=$S($$TEDOK(IEN):0,1:1)
D UNED^DDSUTL("TERM","PXRM OCR MAIN BLOCK",1,VALUE)
Q
;
;=============================================
SMANEDIT(IEN,NEW) ;Invoke the ScreeMan editor for entry IEN.
N DA,DR,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,RESTRICT,RULCLASS
S DDSFILE=801.1,DDSPARM="CS"
S RULCLASS=$P($G(^PXD(801.1,IEN,100)),U,1)
S RESTRICT=$S($G(PXRMINST):0,RULCLASS="N":1,1:0)
S DR=$S(RESTRICT:"[PXRM OCR EDIT RESTRICTED]",1:"[PXRM OCR EDIT]")
S DA=IEN
D ^DDS
;If the entry is new and the user did not save, delete it.
I $G(NEW),$G(DDSSAVE)'=1 D DELETE^PXRMEXFI(801.1,IEN) Q
;If changes were made update the edit history.
I $G(DDSCHANG)'=1 Q
;Make sure the change was not a deletion.
I '$D(^PXD(801.1,IEN)) Q
;Update the edit history.
N IENS,FDA,FDAIEN,MSG
S IENS="+1,"_IEN_","
S FDA(801.13,IENS,.01)=$$NOW^XLFDT
S FDA(801.13,IENS,1)=DUZ
D UPDATE^DIE("S","FDA","FDAIEN","MSG")
K DA,DDSFILE
S DA=FDAIEN(1),DA(1)=IEN
S DDSFILE=801.1,DDSFILE(1)=801.13
S DR="[PXRM OCR EDIT HISTORY]"
D ^DDS
Q
;
;=============================================
TCAP(IEN) ;This is the executable caption for the term.
;I '$$TEDOK(IEN) Q ""
I '$$TEDOK(IEN) Q " "
N TIEN
S TIEN=$$GET^DDSVAL(801.1,IEN,"REMINDER TERM")
I TIEN="" Q "TERM: "
Q "TERM: "_$P(^PXRMD(811.5,TIEN,0),U,1)
;
;=============================================
TEDOK(IEN) ;The term in a rule can be edited as long as a definition has
;not been defined.
I $$GET^DDSVAL(801.1,IEN,"REMINDER DEFINITION")="" Q 1
Q 0
;
;=============================================
TDEL(IEN,OLD,NEW) ;Kill logic for AT cross-reference.
I $G(NEW)>0 Q
D DELFIELD(IEN,21)
Q
;
;=============================================
TPOST(IEN) ;Term post-action.
;If the term is defined, do not allow navigation to the definition.
N VALUE
S VALUE=$S($$DEDOK(IEN):0,1:1)
D UNED^DDSUTL("DEFINITION","PXRM OCR MAIN BLOCK",1,VALUE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMOCR 6284 printed Apr 09, 2024@20:52:20 Page 2
PXRMOCR ;SLC/PKR - Routines for editing order check rules ;03/17/2016 11:37
+1 ;;2.0;CLINICAL REMINDERS;**22,45**;Feb 04, 2005;Build 566
+2 ;Also contains routines used by the DD for file #801.1.
+3 ;=============================================
CHECK(IEN,DDSBR,DDSERROR) ;Check a rule for errors, called by DATA
+1 ;VALIDATION on form.
+2 NEW CHKTXT,DEF,DEFOUT,OCTEXT,TERM,TEXT
+3 ;Either a term or definition must be defined.
+4 SET TERM=$$GET^DDSVAL(801.1,IEN,20)
+5 SET DEF=$$GET^DDSVAL(801.1,IEN,30)
+6 SET CHKTXT=1
+7 IF TERM=""
IF DEF=""
Begin DoDot:1
+8 SET CHKTXT=0
+9 SET TEXT="Either a term or defintion must be defined."
+10 SET DDSERROR=1
+11 SET DDSBR="TERM^PXRM OCR MAIN BLOCK^1"
+12 IF $DATA(DDS)
DO HLP^DDSUTL(TEXT)
+13 IF '$TEST
DO EN^DDIOL(TEXT)
End DoDot:1
QUIT
+14 IF (TERM'="")
IF ($$GET^DDSVAL(801.1,IEN,21)="")
Begin DoDot:1
+15 SET CHKTXT=0
+16 SET TEXT="The TERM EVALUATION STATUS is missing."
+17 SET DDSERROR=1
+18 SET DDSBR="TERM EVALUATION STATUS^PXRM OCR TERM^20"
+19 IF $DATA(DDS)
DO MSG^DDSUTL(TEXT)
+20 IF '$TEST
DO EN^DDIOL(TEXT)
End DoDot:1
QUIT
+21 IF (DEF'="")
IF ($$GET^DDSVAL(801.1,IEN,31)="")
Begin DoDot:1
+22 SET CHKTXT=0
+23 SET TEXT="The DEFINITION EVALUATION STATUS is missing."
+24 SET DDSERROR=1
+25 SET DDSBR="DEFINITION EVALUATION STATUS^PXRM OCR DEFINITION^30"
+26 IF $DATA(DDS)
DO MSG^DDSUTL(TEXT)
+27 IF '$TEST
DO EN^DDIOL(TEXT)
End DoDot:1
QUIT
+28 SET DEFOUT=$$GET^DDSVAL(801.1,IEN,32)
+29 IF (DEF'="")
IF (DEFOUT="")
Begin DoDot:1
+30 SET CHKTXT=0
+31 SET TEXT="The OUTPUT TEXT is missing."
+32 SET DDSERROR=1
+33 SET DDSBR="OUTPUT TEXT^PXRM OCR DEFINITION^30"
+34 IF $DATA(DDS)
DO MSG^DDSUTL(TEXT)
+35 IF '$TEST
DO EN^DDIOL(TEXT)
End DoDot:1
QUIT
+36 IF TERM=""&(DEF=""&(DEFOUT="D"))
QUIT
+37 SET OCTEXT=$$GET^DDSVAL(801.1,IEN,"ORDER CHECK TEXT")
+38 IF CHKTXT=1
IF $$WPNCHAR^PXRMSMAN(OCTEXT)=0
Begin DoDot:1
+39 SET TEXT="There is no ORDER CHECK TEXT."
+40 SET DDSERROR=1
+41 SET DDSBR="ORDER CHECK TEXT^PXRM OCR MAIN BLOCK^1"
+42 IF $DATA(DDS)
DO MSG^DDSUTL(TEXT)
+43 IF '$TEST
DO EN^DDIOL(TEXT)
End DoDot:1
QUIT
+44 DO FOCTXT(IEN,OCTEXT,.DDSBR,.DDSERROR)
+45 QUIT
+46 ;
+47 ;=============================================
DCAP(IEN) ;This is the executable caption for the definition.
+1 IF '$$DEDOK(IEN)
QUIT ""
+2 NEW DIEN
+3 SET DIEN=$$GET^DDSVAL(801.1,IEN,"REMINDER DEFINITION")
+4 IF DIEN=""
QUIT "DEFINITION: "
+5 QUIT "DEFINITION: "_$PIECE(^PXD(811.9,DIEN,0),U,1)
+6 ;
+7 ;=============================================
DDEL(IEN,OLD,NEW) ;Kill logic for AD cross-reference.
+1 IF $GET(NEW)>0
QUIT
+2 DO DELFIELD(IEN,31)
+3 DO DELFIELD(IEN,32)
+4 QUIT
+5 ;
+6 ;=============================================
DEDOK(IEN) ;The definition in a rule can be edited as long as a term has
+1 ;not been defined.
+2 IF $$GET^DDSVAL(801.1,IEN,"REMINDER TERM")=""
QUIT 1
+3 QUIT 0
+4 ;
+5 ;===================================
DELFIELD(IEN,FIELD) ;Delete a field.
+1 NEW FDA,IENS,MSG
+2 SET IENS=IEN_","
+3 SET FDA(801.1,IENS,FIELD)="@"
+4 DO FILE^DIE("","FDA","MSG")
+5 QUIT
+6 ;
+7 ;=============================================
DPOST(IEN) ;Definition post-action.
+1 ;If the definition is defined do not allow navigation to the term.
+2 NEW VALUE
+3 SET VALUE=$SELECT($$TEDOK(IEN):0,1:1)
+4 DO UNED^DDSUTL("TERM","PXRM OCR MAIN BLOCK",1,VALUE)
+5 QUIT
+6 ;
+7 ;=============================================
FOCTXT(IEN,OCTEXT,DDSBR,DDSERROR) ;Format and store the order check text as
+1 ;long as it does not contain a TIU object.
+2 NEW FDA,IENS,IND,MSG,NIN,NOUT,NPIPE,TEXTIN,TEXTOUT
+3 SET NIN=$PIECE(@OCTEXT@(0),U,4)
+4 SET NPIPE=0
+5 FOR IND=1:1:NIN
Begin DoDot:1
+6 SET TEXTIN(IND)=@OCTEXT@(IND,0)
+7 SET NPIPE=NPIPE+$LENGTH(TEXTIN(IND),"|")-1
End DoDot:1
+8 SET $PIECE(^PXD(801.1,IEN,5),U,1)=NIN
+9 ;Remove existing formatted text.
+10 KILL ^PXD(801.1,IEN,6)
SET $PIECE(^PXD(801.1,IEN,5),U,2)=0
+11 IF NPIPE=0
Begin DoDot:1
+12 ;No TIU Objects, format and save the text.
+13 DO FORMAT^PXRMTEXT(1,80,NIN,.TEXTIN,.NOUT,.TEXTOUT)
+14 SET $PIECE(^PXD(801.1,IEN,5),U,2)=NOUT
+15 SET IENS=IEN_","
+16 SET FDA(801.1,IENS,47)="TEXTOUT"
+17 DO UPDATE^DIE("","FDA","","MSG")
End DoDot:1
QUIT
+18 IF (NPIPE#2)=1
Begin DoDot:1
+19 ;There is an odd number of pipes.
+20 SET TEXTOUT(1)="Warning, the Order Check Text has "_NPIPE_" '|' characters."
+21 SET TEXTOUT(2)="Because this is an odd number, TIU Object expansion will not work."
+22 SET DDSERROR=1
+23 SET DDSBR="ORDER CHECK TEXT^PXRM OCR MAIN BLOCK^1"
+24 IF $DATA(DDS)
DO MSG^DDSUTL(.TEXTOUT)
+25 IF '$TEST
DO EN^DDIOL(.TEXTOUT)
End DoDot:1
+26 QUIT
+27 ;
+28 ;=============================================
FORMPRE(IEN) ;Form pre-action.
+1 ;If the term is defined, do not allow navigation to the definition.
+2 NEW VALUE
+3 SET VALUE=$SELECT($$DEDOK(IEN):0,1:1)
+4 DO UNED^DDSUTL("DEFINITION","PXRM OCR MAIN BLOCK",1,VALUE)
+5 ;If the definition is defined do not allow navigation to the term.
+6 SET VALUE=$SELECT($$TEDOK(IEN):0,1:1)
+7 DO UNED^DDSUTL("TERM","PXRM OCR MAIN BLOCK",1,VALUE)
+8 QUIT
+9 ;
+10 ;=============================================
SMANEDIT(IEN,NEW) ;Invoke the ScreeMan editor for entry IEN.
+1 NEW DA,DR,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,RESTRICT,RULCLASS
+2 SET DDSFILE=801.1
SET DDSPARM="CS"
+3 SET RULCLASS=$PIECE($GET(^PXD(801.1,IEN,100)),U,1)
+4 SET RESTRICT=$SELECT($GET(PXRMINST):0,RULCLASS="N":1,1:0)
+5 SET DR=$SELECT(RESTRICT:"[PXRM OCR EDIT RESTRICTED]",1:"[PXRM OCR EDIT]")
+6 SET DA=IEN
+7 DO ^DDS
+8 ;If the entry is new and the user did not save, delete it.
+9 IF $GET(NEW)
IF $GET(DDSSAVE)'=1
DO DELETE^PXRMEXFI(801.1,IEN)
QUIT
+10 ;If changes were made update the edit history.
+11 IF $GET(DDSCHANG)'=1
QUIT
+12 ;Make sure the change was not a deletion.
+13 IF '$DATA(^PXD(801.1,IEN))
QUIT
+14 ;Update the edit history.
+15 NEW IENS,FDA,FDAIEN,MSG
+16 SET IENS="+1,"_IEN_","
+17 SET FDA(801.13,IENS,.01)=$$NOW^XLFDT
+18 SET FDA(801.13,IENS,1)=DUZ
+19 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
+20 KILL DA,DDSFILE
+21 SET DA=FDAIEN(1)
SET DA(1)=IEN
+22 SET DDSFILE=801.1
SET DDSFILE(1)=801.13
+23 SET DR="[PXRM OCR EDIT HISTORY]"
+24 DO ^DDS
+25 QUIT
+26 ;
+27 ;=============================================
TCAP(IEN) ;This is the executable caption for the term.
+1 ;I '$$TEDOK(IEN) Q ""
+2 IF '$$TEDOK(IEN)
QUIT " "
+3 NEW TIEN
+4 SET TIEN=$$GET^DDSVAL(801.1,IEN,"REMINDER TERM")
+5 IF TIEN=""
QUIT "TERM: "
+6 QUIT "TERM: "_$PIECE(^PXRMD(811.5,TIEN,0),U,1)
+7 ;
+8 ;=============================================
TEDOK(IEN) ;The term in a rule can be edited as long as a definition has
+1 ;not been defined.
+2 IF $$GET^DDSVAL(801.1,IEN,"REMINDER DEFINITION")=""
QUIT 1
+3 QUIT 0
+4 ;
+5 ;=============================================
TDEL(IEN,OLD,NEW) ;Kill logic for AT cross-reference.
+1 IF $GET(NEW)>0
QUIT
+2 DO DELFIELD(IEN,21)
+3 QUIT
+4 ;
+5 ;=============================================
TPOST(IEN) ;Term post-action.
+1 ;If the term is defined, do not allow navigation to the definition.
+2 NEW VALUE
+3 SET VALUE=$SELECT($$DEDOK(IEN):0,1:1)
+4 DO UNED^DDSUTL("DEFINITION","PXRM OCR MAIN BLOCK",1,VALUE)
+5 QUIT
+6 ;
