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