- BHSDEN2 ;IHS/CIA/MGH - Health Summary for Dental ;17-Mar-2006 10:36;MGH
- ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006
- ;===================================================================
- ;Taken from ADERVW2
- ; IHS/HQT/MJL - DENTAL CHART REVW PART 4 ; [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;**12**;APRIL 1999
- ;Health summary for dental, followup and failed appointments
- ;====================================================================
- DO ; EP
- D CKP^GMTSUP Q:$D(GMTSQIT)
- FAIL I '$D(^ADEPAT(ADEPAT,"FA")) S ADETXT="<No Failed Appointments>",ADENRQ="",ADEICL=0 W ! X ADEPRT G ACTIV
- S ADETXT="FAILED DENTAL APPOINTMENTS:",ADENRQ="",ADEICL=20 W ! X ADEPRT
- S:'$D(ADENDM) ADENDM=10 S ADENDMS=ADENDM
- ;IHS/ANMC/HMW 11-1-2002 **12** Replaced next line with one following to display
- ;failed appts in reverse chronological order
- S ADER=9999999 F S ADER=$O(^ADEPAT(ADEPAT,"FA",ADER),-1) Q:'+ADER D
- .S X=$P($G(^ADEPAT(ADEPAT,"FA",ADER,0)),U)
- .I +X D REGDT4^GMTSU S ADETXT=X_" "_$S($P(^ADEPAT(ADEPAT,"FA",ADER,0),U,2)="b":"BROKEN",1:"CANCELLED") S ADEICL=0,ADENRQ="" X ADEPRT S ADENDMS=ADENDMS-1 Q:'ADENDMS
- ACTIV I '$D(^ADEFOL("TYPE",ADEPAT)) S ADETXT="<Not on Active Dental Followup>",ADENRQ="",ADEICL=0 W ! X ADEPRT G PREV
- S ADETXT="ACTIVE DENTAL FOLLOWUP SUMMARY:",ADENRQ="",ADEICL=20 W ! X ADEPRT
- S ADETYP=0 F ADEQ=0:0 S ADETYP=$O(^ADEFOL("TYPE",ADEPAT,ADETYP)) Q:ADETYP="" S ADENRQ="",ADETYPN=$S(ADETYP="w":"WAITING",ADETYP="rf":"REFERRAL",ADETYP="rc":"RECALL")_" LIST" D R2
- ;------->PREVIOUS FOLLOWUP
- PREV I '$D(^ADEPAT(ADEPAT,"FOL")) S ADETXT="<No Previous Followup>",ADENRQ="",ADEICL=0 W ! X ADEPRT G END
- S ADETXT="PREVIOUS DENTAL FOLLOWUP:",ADENRQ="",ADEICL=20 W ! X ADEPRT
- S ADETXT="TYPE: ADDED: REMOVED:",ADENRQ="",ADEICL=0 X ADEPRT
- S:'$D(ADENDM) ADENDM=10 S ADENDMS=ADENDM
- S ADESUB=0 F ADEQ=0:0 S ADESUB=$O(^ADEPAT(ADEPAT,"FOL","B",ADESUB)) Q:'+ADESUB D P1 S ADESUBD=0 F ADEQ=0:0 S ADESUBD=$O(^ADEPAT(ADEPAT,"FOL","B",ADESUB,ADESUBD)) Q:'+ADESUBD D P2 S ADENDMS=ADENDMS-1 Q:ADENDMS=0
- ;
- END Q
- R2 S ADECAT=0 F ADEQ=0:0 S ADECAT=$O(^ADEFOL("TYPE",ADEPAT,ADETYP,ADECAT)) Q:'+ADECAT S ADETXT=$P(^ADETYP(ADECAT,0),U),ADENRQ="",ADEICL=0 D R3
- Q
- R3 S ADEMDFN=0 F ADEQ=0:0 S ADEMDFN=$O(^ADEFOL("TYPE",ADEPAT,ADETYP,ADECAT,ADEMDFN)) Q:'+ADEMDFN D R4
- Q
- R4 ;
- S X=$P(^ADEFOL(ADEMDFN,0),U,3) D REGDT4^GMTSU S ADETXT=X_" "_ADETXT_" "_ADETYPN
- S X=$P(^ADEFOL(ADEMDFN,0),U,4) D REGDT4^GMTSU S ADETXT=ADETXT_" Action: "_X S:$P(^ADEFOL(ADEMDFN,0),U,5)="u" ADETXT=ADETXT_" **URGENT**" X ADEPRT D:$P(^ADEFOL(ADEMDFN,0),U,6)]"" R5 Q
- R5 S ADETXT="ACTION TAKEN: "_$P(^ADEFOL(ADEMDFN,0),U,6),ADEICL=15 X ADEPRT S ADEICL=0 Q
- P1 S ADETXT=$P(^ADETYP(ADESUB,0),U) ;
- S ADETXT=ADETXT_" "_$S($P(^ADETYP(ADESUB,0),U,4)="w":"WAITING",$P(^(0),U,4)="rc":"RECALL",$P(^(0),U,4)="rf":"REFERRAL",1:"OTHER")_" LIST"
- S ADENRQ="",ADEICL=0 X ADEPRT
- Q
- P2 S X=$P(^ADEPAT(ADEPAT,"FOL",ADESUBD,0),U,2) D REGDT4^GMTSU S ADETXT=X
- S X=$P(^ADEPAT(ADEPAT,"FOL",ADESUBD,0),U,3) D REGDT4^GMTSU S ADETXT=ADETXT_" "_X
- S ADENRQ="",ADEICL=20 X ADEPRT
- Q
- BHSDEN2 ;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 ADERVW2
- +4 ; IHS/HQT/MJL - DENTAL CHART REVW PART 4 ; [ 03/24/1999 9:04 AM ]
- +5 ;;6.0;ADE;**12**;APRIL 1999
- +6 ;Health summary for dental, followup and failed appointments
- +7 ;====================================================================
- DO ; EP
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- FAIL IF '$DATA(^ADEPAT(ADEPAT,"FA"))
- SET ADETXT="<No Failed Appointments>"
- SET ADENRQ=""
- SET ADEICL=0
- WRITE !
- XECUTE ADEPRT
- GOTO ACTIV
- +1 SET ADETXT="FAILED DENTAL APPOINTMENTS:"
- SET ADENRQ=""
- SET ADEICL=20
- WRITE !
- XECUTE ADEPRT
- +2 IF '$DATA(ADENDM)
- SET ADENDM=10
- SET ADENDMS=ADENDM
- +3 ;IHS/ANMC/HMW 11-1-2002 **12** Replaced next line with one following to display
- +4 ;failed appts in reverse chronological order
- +5 SET ADER=9999999
- FOR
- SET ADER=$ORDER(^ADEPAT(ADEPAT,"FA",ADER),-1)
- IF '+ADER
- QUIT
- Begin DoDot:1
- +6 SET X=$PIECE($GET(^ADEPAT(ADEPAT,"FA",ADER,0)),U)
- +7 IF +X
- DO REGDT4^GMTSU
- SET ADETXT=X_" "_$SELECT($PIECE(^ADEPAT(ADEPAT,"FA",ADER,0),U,2)="b":"BROKEN",1:"CANCELLED")
- SET ADEICL=0
- SET ADENRQ=""
- XECUTE ADEPRT
- SET ADENDMS=ADENDMS-1
- IF 'ADENDMS
- QUIT
- End DoDot:1
- ACTIV IF '$DATA(^ADEFOL("TYPE",ADEPAT))
- SET ADETXT="<Not on Active Dental Followup>"
- SET ADENRQ=""
- SET ADEICL=0
- WRITE !
- XECUTE ADEPRT
- GOTO PREV
- +1 SET ADETXT="ACTIVE DENTAL FOLLOWUP SUMMARY:"
- SET ADENRQ=""
- SET ADEICL=20
- WRITE !
- XECUTE ADEPRT
- +2 SET ADETYP=0
- FOR ADEQ=0:0
- SET ADETYP=$ORDER(^ADEFOL("TYPE",ADEPAT,ADETYP))
- IF ADETYP=""
- QUIT
- SET ADENRQ=""
- SET ADETYPN=$SELECT(ADETYP="w":"WAITING",ADETYP="rf":"REFERRAL",ADETYP="rc":"RECALL")_" LIST"
- DO R2
- +3 ;------->PREVIOUS FOLLOWUP
- PREV IF '$DATA(^ADEPAT(ADEPAT,"FOL"))
- SET ADETXT="<No Previous Followup>"
- SET ADENRQ=""
- SET ADEICL=0
- WRITE !
- XECUTE ADEPRT
- GOTO END
- +1 SET ADETXT="PREVIOUS DENTAL FOLLOWUP:"
- SET ADENRQ=""
- SET ADEICL=20
- WRITE !
- XECUTE ADEPRT
- +2 SET ADETXT="TYPE: ADDED: REMOVED:"
- SET ADENRQ=""
- SET ADEICL=0
- XECUTE ADEPRT
- +3 IF '$DATA(ADENDM)
- SET ADENDM=10
- SET ADENDMS=ADENDM
- +4 SET ADESUB=0
- FOR ADEQ=0:0
- SET ADESUB=$ORDER(^ADEPAT(ADEPAT,"FOL","B",ADESUB))
- IF '+ADESUB
- QUIT
- DO P1
- SET ADESUBD=0
- FOR ADEQ=0:0
- SET ADESUBD=$ORDER(^ADEPAT(ADEPAT,"FOL","B",ADESUB,ADESUBD))
- IF '+ADESUBD
- QUIT
- DO P2
- SET ADENDMS=ADENDMS-1
- IF ADENDMS=0
- QUIT
- +5 ;
- END QUIT
- R2 SET ADECAT=0
- FOR ADEQ=0:0
- SET ADECAT=$ORDER(^ADEFOL("TYPE",ADEPAT,ADETYP,ADECAT))
- IF '+ADECAT
- QUIT
- SET ADETXT=$PIECE(^ADETYP(ADECAT,0),U)
- SET ADENRQ=""
- SET ADEICL=0
- DO R3
- +1 QUIT
- R3 SET ADEMDFN=0
- FOR ADEQ=0:0
- SET ADEMDFN=$ORDER(^ADEFOL("TYPE",ADEPAT,ADETYP,ADECAT,ADEMDFN))
- IF '+ADEMDFN
- QUIT
- DO R4
- +1 QUIT
- R4 ;
- +1 SET X=$PIECE(^ADEFOL(ADEMDFN,0),U,3)
- DO REGDT4^GMTSU
- SET ADETXT=X_" "_ADETXT_" "_ADETYPN
- +2 SET X=$PIECE(^ADEFOL(ADEMDFN,0),U,4)
- DO REGDT4^GMTSU
- SET ADETXT=ADETXT_" Action: "_X
- IF $PIECE(^ADEFOL(ADEMDFN,0),U,5)="u"
- SET ADETXT=ADETXT_" **URGENT**"
- XECUTE ADEPRT
- IF $PIECE(^ADEFOL(ADEMDFN,0),U,6)]""
- DO R5
- QUIT
- R5 SET ADETXT="ACTION TAKEN: "_$PIECE(^ADEFOL(ADEMDFN,0),U,6)
- SET ADEICL=15
- XECUTE ADEPRT
- SET ADEICL=0
- QUIT
- P1 ;
- SET ADETXT=$PIECE(^ADETYP(ADESUB,0),U)
- +1 SET ADETXT=ADETXT_" "_$SELECT($PIECE(^ADETYP(ADESUB,0),U,4)="w":"WAITING",$PIECE(^(0),U,4)="rc":"RECALL",$PIECE(^(0),U,4)="rf":"REFERRAL",1:"OTHER")_" LIST"
- +2 SET ADENRQ=""
- SET ADEICL=0
- XECUTE ADEPRT
- +3 QUIT
- P2 SET X=$PIECE(^ADEPAT(ADEPAT,"FOL",ADESUBD,0),U,2)
- DO REGDT4^GMTSU
- SET ADETXT=X
- +1 SET X=$PIECE(^ADEPAT(ADEPAT,"FOL",ADESUBD,0),U,3)
- DO REGDT4^GMTSU
- SET ADETXT=ADETXT_" "_X
- +2 SET ADENRQ=""
- SET ADEICL=20
- XECUTE ADEPRT
- +3 QUIT
