- 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
- ;
- 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 ;