ADERVW0.m

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

 ;;6.0;ADE;;APRIL 1999

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 X ADECKP Q:$D(APCHSQIT)  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_" "_%

 W !,ADEHDR,!,%,!

 Q

 ;

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

 Q

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

 +1       ;;6.0;ADE;;APRIL 1999

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

           XECUTE ADECKP

           IF $DATA(APCHSQIT)

               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        WRITE !,ADEHDR,!,%,!

 +3        QUIT 

 +4       ;

BREAK      SET %=""

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

           SET %=%_" "_APCHSEGH_APCHSEGL_" "_%

           WRITE !,%,!!

 +1        QUIT