BHSDEN0.m

BHSDEN0 ;IHS/CIA/MGH - Health Summary for Dental ;17-Mar-2006 10:36;MGH

 ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

 ;===================================================================

 ;Taken from ADERVW0

 ; IHS/HQT/MJL  - DENTAL CHART REVW PT 2 ;09:34 PM  [ 03/24/1999   9:04

 ;;6.0;ADE;;APRIL 1999

 ;Health summary for dental, printout of data

PRTTXT ;EP

 S ADEDLT=1,ADEILN=IOM-ADEICL-1

 F ADEQ=0:0 S:ADENRQ]""&(($L(ADENRQ)+$L(ADETXT)+2)<255) ADETXT=$S(ADETXT]"":ADETXT_"; ",1:"")_ADENRQ,ADENRQ="" Q:ADETXT=""  D PRTTXT2

 K ADEILN,ADEDLT,ADEF,ADEC,ADETXT

 Q

PRTTXT2 D GETFRAG D CKP^GMTSUP Q:$D(GMTSSQIT)  W ?ADEICL W ADEF,! S ADEICL=ADEICL+ADEDLT,ADEILN=ADEILN-ADEDLT,ADEDLT=0

 Q

GETFRAG I $L(ADETXT)<ADEILN S ADEF=ADETXT,ADETXT="" Q

 F ADEC=ADEILN:-1:1 Q:$E(ADETXT,ADEC)=" "

 S ADEF=$E(ADETXT,1,ADEC-1),ADETXT=$E(ADETXT,ADEC+1,255)

 Q

GETSITE ;EP

 S:ADESITE="" ADESITE="null"

 S %=$S($D(^AUTTLOC(ADESITE,0)):^(0),1:"")

 S ADENSH=$P(%,U,2) I ADENSH="" S ADENSH="<"_ADESITE_">"

 Q

HEADER ;EP

 S ADEPG=ADEPG+1,ADEHD2=$P(^DPT(ADEPAT,0),U,1)_"  (DENTAL SUMMARY)  pg. "_ADEPG,%="",$P(%,"*",((IOM-4-$L(ADEHD2))\2)+1)="*",%=%_" "_ADEHD2_" "_%

 D CKP^GMTSUP Q:$D(GMTSQIT)

 W !,ADEHDR,!,%,!

 Q

 ;

BREAK S %="",$P(%,"-",IOM-3-$L(GMTSEGH_GMTSEGL)/2)="",%=%_" "_GMTSEGH_GMTSEGL_" "_% W !,%,!!

 Q

BHSDEN0   ;IHS/CIA/MGH - Health Summary for Dental ;17-Mar-2006 10:36;MGH

 +1       ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

 +2       ;===================================================================

 +3       ;Taken from ADERVW0

 +4       ; IHS/HQT/MJL  - DENTAL CHART REVW PT 2 ;09:34 PM  [ 03/24/1999   9:04

 +5       ;;6.0;ADE;;APRIL 1999

 +6       ;Health summary for dental, printout of data

PRTTXT    ;EP

 +1        SET ADEDLT=1

           SET ADEILN=IOM-ADEICL-1

 +2        FOR ADEQ=0:0

               IF ADENRQ]""&(($LENGTH(ADENRQ)+$LENGTH(ADETXT)+2)<255)

                   SET ADETXT=$SELECT(ADETXT]"":ADETXT_"; ",1:"")_ADENRQ

                   SET ADENRQ=""

               IF ADETXT=""

                   QUIT 

               DO PRTTXT2

 +3        KILL ADEILN,ADEDLT,ADEF,ADEC,ADETXT

 +4        QUIT 

PRTTXT2    DO GETFRAG

           DO CKP^GMTSUP

           IF $DATA(GMTSSQIT)

               QUIT 

           WRITE ?ADEICL

           WRITE ADEF,!

           SET ADEICL=ADEICL+ADEDLT

           SET ADEILN=ADEILN-ADEDLT

           SET ADEDLT=0

 +1        QUIT 

GETFRAG    IF $LENGTH(ADETXT)<ADEILN

               SET ADEF=ADETXT

               SET ADETXT=""

               QUIT 

 +1        FOR ADEC=ADEILN:-1:1

               IF $EXTRACT(ADETXT,ADEC)=" "

                   QUIT 

 +2        SET ADEF=$EXTRACT(ADETXT,1,ADEC-1)

           SET ADETXT=$EXTRACT(ADETXT,ADEC+1,255)

 +3        QUIT 

GETSITE   ;EP

 +1        IF ADESITE=""

               SET ADESITE="null"

 +2        SET %=$SELECT($DATA(^AUTTLOC(ADESITE,0)):^(0),1:"")

 +3        SET ADENSH=$PIECE(%,U,2)

           IF ADENSH=""

               SET ADENSH="<"_ADESITE_">"

 +4        QUIT 

HEADER    ;EP

 +1        SET ADEPG=ADEPG+1

           SET ADEHD2=$PIECE(^DPT(ADEPAT,0),U,1)_"  (DENTAL SUMMARY)  pg. "_ADEPG

           SET %=""

           SET $PIECE(%,"*",((IOM-4-$LENGTH(ADEHD2))\2)+1)="*"

           SET %=%_" "_ADEHD2_" "_%

 +2        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

 +3        WRITE !,ADEHDR,!,%,!

 +4        QUIT 

 +5       ;

BREAK      SET %=""

           SET $PIECE(%,"-",IOM-3-$LENGTH(GMTSEGH_GMTSEGL)/2)=""

           SET %=%_" "_GMTSEGH_GMTSEGL_" "_%

           WRITE !,%,!!

 +1        QUIT