PXRMSMAN.m

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      ;