PXRMSMAN ;SLC/PKR - Utilities for working with ScreenMan ;12/16/2011
;;2.0;CLINICAL REMINDERS;**22**;Feb 04, 2005;Build 160
;=============================================
FSOC(FILENUM,FIELD) ;Format a set of codes for display in ScreenMan.
N CODES,MSG,LEN,NL,TEXTOUT
S CODES=$$GET1^DID(FILENUM,FIELD,"","POINTER","MSG")
S CODES=$TR(CODES,":","=")
S CODES=$$STRREP^PXRMUTIL(CODES,";",", ")
D FORMATS^PXRMTEXT(1,IOM,CODES,.NL,.TEXTOUT)
S LEN=$L(TEXTOUT(NL))
S:$E(TEXTOUT(NL),LEN)="," TEXTOUT(NL)=$E(TEXTOUT(NL),1,(LEN-1))
D HLP^DDSUTL(.TEXTOUT)
Q
;
;=============================================
WPECAP(FNUM,DA,FIELD,MAXLEN) ;Executable caption for word-processing fields.
;FNUM is the file number and FIELD is the field name. MAXLEN is
;74-$L(FIELD). Pass it as parameter so it does not need to be
;constantly recomputed.
N L1,TEXT,WPTEXT
S WPTEXT=$$GET^DDSVAL(FNUM,.DA,FIELD)
S TEXT=FIELD_": "
I $$WPNCHAR^PXRMSMAN(WPTEXT)=0 Q TEXT
S L1=@WPTEXT@(1,0)
S LEN=$L(L1)
Q TEXT_$S(LEN>MAXLEN:$E(L1,1,MAXLEN)_" ...",1:L1)
;
;=============================================
WPNCHAR(WP) ;Return 0 if a word-processing field does not contain any text.
I '$D(@WP@(0)) Q 0
N LN,NC
S NC=0
F LN=1:1:$P(@WP@(0),U,4) Q:NC>0 S NC=NC+$L(@WP@(LN,0))
Q NC
;
;=============================================
VSPON(FILENUM,DA,SPONIEN,DDSERROR) ;Make sure the Class of the Sponsor matches
;the Class of the entry.
N CLASS,SCLASS
S CLASS=$$GET^DDSVAL(FILENUM,DA,100,,"E")
S SCLASS=$$GET1^DIQ(811.6,SPONIEN,100)
I CLASS=SCLASS Q
N TEXT
S TEXT(1)="The entry's class is "_CLASS_"."
S TEXT(2)="The selected sponsor's class is "_SCLASS_"."
S TEXT(3)="They must match."
D HLP^DDSUTL(.TEXT)
S DDSERROR=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSMAN 1768 printed Dec 13, 2024@01:49:12 Page 2
PXRMSMAN ;SLC/PKR - Utilities for working with ScreenMan ;12/16/2011
+1 ;;2.0;CLINICAL REMINDERS;**22**;Feb 04, 2005;Build 160
+2 ;=============================================
FSOC(FILENUM,FIELD) ;Format a set of codes for display in ScreenMan.
+1 NEW CODES,MSG,LEN,NL,TEXTOUT
+2 SET CODES=$$GET1^DID(FILENUM,FIELD,"","POINTER","MSG")
+3 SET CODES=$TRANSLATE(CODES,":","=")
+4 SET CODES=$$STRREP^PXRMUTIL(CODES,";",", ")
+5 DO FORMATS^PXRMTEXT(1,IOM,CODES,.NL,.TEXTOUT)
+6 SET LEN=$LENGTH(TEXTOUT(NL))
+7 if $EXTRACT(TEXTOUT(NL),LEN)=","
SET TEXTOUT(NL)=$EXTRACT(TEXTOUT(NL),1,(LEN-1))
+8 DO HLP^DDSUTL(.TEXTOUT)
+9 QUIT
+10 ;
+11 ;=============================================
WPECAP(FNUM,DA,FIELD,MAXLEN) ;Executable caption for word-processing fields.
+1 ;FNUM is the file number and FIELD is the field name. MAXLEN is
+2 ;74-$L(FIELD). Pass it as parameter so it does not need to be
+3 ;constantly recomputed.
+4 NEW L1,TEXT,WPTEXT
+5 SET WPTEXT=$$GET^DDSVAL(FNUM,.DA,FIELD)
+6 SET TEXT=FIELD_": "
+7 IF $$WPNCHAR^PXRMSMAN(WPTEXT)=0
QUIT TEXT
+8 SET L1=@WPTEXT@(1,0)
+9 SET LEN=$LENGTH(L1)
+10 QUIT TEXT_$SELECT(LEN>MAXLEN:$EXTRACT(L1,1,MAXLEN)_" ...",1:L1)
+11 ;
+12 ;=============================================
WPNCHAR(WP) ;Return 0 if a word-processing field does not contain any text.
+1 IF '$DATA(@WP@(0))
QUIT 0
+2 NEW LN,NC
+3 SET NC=0
+4 FOR LN=1:1:$PIECE(@WP@(0),U,4)
if NC>0
QUIT
SET NC=NC+$LENGTH(@WP@(LN,0))
+5 QUIT NC
+6 ;
+7 ;=============================================
VSPON(FILENUM,DA,SPONIEN,DDSERROR) ;Make sure the Class of the Sponsor matches
+1 ;the Class of the entry.
+2 NEW CLASS,SCLASS
+3 SET CLASS=$$GET^DDSVAL(FILENUM,DA,100,,"E")
+4 SET SCLASS=$$GET1^DIQ(811.6,SPONIEN,100)
+5 IF CLASS=SCLASS
QUIT
+6 NEW TEXT
+7 SET TEXT(1)="The entry's class is "_CLASS_"."
+8 SET TEXT(2)="The selected sponsor's class is "_SCLASS_"."
+9 SET TEXT(3)="They must match."
+10 DO HLP^DDSUTL(.TEXT)
+11 SET DDSERROR=1
+12 QUIT
+13 ;
