ADEATT4 ; IHS/HQT/MJL - ATTENDING DDS STMNT PT 4 ;11:42 AM [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
;------->INIT
INIT U IO K ADELIN S $P(ADELIN,"=",79)="",ADEPAG=0
;------->D HEADER
D HEAD
;------->CARRIER NAME
D CAR
;------->PATIENT NAME
D PAT
;------->PROVIDER
D PROV
;------->PROCEDURES
D PROC
;------->TOTAL CHARGE
D TOT
;------->SIGNATURE
D SIG
;------->END
END ;
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K ADEPAG
Q
LINE W $E(ADELIN,1,40-($L(ADETITL)/2)),ADETITL,$E(ADELIN,1,39-($L(ADETITL)/2)) Q
HEAD W:ADEPAG'=0 @IOF S ADEPAG=ADEPAG+1,ADETITL="ATTENDING DENTIST STATEMENT",ADELIN="",$P(ADELIN," ",50)="" S:ADEPAG>1 ADETITL=ADETITL_" Page "_ADEPAG D LINE S $Y=1
I ADEPAG>1 S ADETITL="Patient: "_ADEPNM D LINE
S ADELIN="",$P(ADELIN,"=",79)=""
Q
CAR S ADETITL="Carrier Name and Address" W !! D LINE
W !,ADEINSN S ADENOD=^AUTNINS(ADEINS,0)
W ! W $P(ADENOD,U,2)
W ! W $P(ADENOD,U,3)
I +$P(ADENOD,U,4),$D(^DIC(5,$P(ADENOD,U,4),0)) W ?30,$P(^DIC(5,$P(ADENOD,U,4),0),U,2)
W ?40,$P(ADENOD,U,5)
Q
PAT S ADETITL="Patient Name and Address" W !! D LINE
W !,ADEPNM
S ADENOD="" I ADEINSN'["MEDICAID",ADEINSN'["MEDICARE",ADEINSN'["RAILROAD RETIREMENT" S ADENOD=$O(^AUPNPRVT(ADEPAT,11,"B",ADEINS,0)),ADENOD=^AUPNPRVT(ADEPAT,11,ADENOD,0)
I $P(ADENOD,U,4)]"",$P(ADENOD,U,5)]"" W ?30,"Relationship to Sponsor: ",$P(^AUTTRLSH($P(ADENOD,U,5),0),U)
W:$P(ADENOD,U,4)]"" !,"Sponsor: ",$P(ADENOD,U,4)
I '$D(^DPT(ADEPAT,.11)) W !,"(Mailing Address Not Available)" Q
S ADENOD=^DPT(ADEPAT,.11)
W !,$P(ADENOD,U)
W !,$P(ADENOD,U,4),?30,$P(^DIC(5,$P(ADENOD,U,5),0),U,2),?40,$P(ADENOD,U,6)
;W !,"PATIENT CITY",?30,"STATE",?40,"ZIP"
W !!,"(Signature on File)"
Q
PROV S ADETITL="Dentist Name" W !! D LINE
W !,ADERDNM ;"DENTIST"
S ADENOD=^AUTTLOC(DUZ(2),0)
W !,$P(ADENOD,U,12) ;"DDS ADDRESS"
;W !,"DDS CITY",?30,"STATE",?40,"ZIP"
W !,$P(ADENOD,U,13),?30,$P(^DIC(5,$P(ADENOD,U,14),0),U,2),?40,$P(ADENOD,U,15)
W !,"Dentist SSN: ",$P(^DIC(16,ADERDNMD,0),U,9) ;"DDS SSN"
Q
PROC S ADETITL="Treatment Provided" W ! D LINE
W !,"Tooth",?10,"Description of Service",?35,"Date",?45,"Procedure",?60,"Fee" S ADETITL="" W ! D LINE
S X=0 F J=0:0 S X=$O(ADEV(X)) Q:X="" D PROC1,EOL
Q
PROC1 Q:$P(ADEV(X),U,3)<1
F K=1:1:$P(ADEV(X),U) D PROC2
Q
PROC2 W !,$S($P($P(ADEV(X),U,2),",",K)]"":^ADEOPS($P($P(ADEV(X),U,2),",",K),88),1:"")
W ?10,ADEDES(X)
W ?35,$E(ADEVFM,4,5),"/",$E(ADEVFM,6,7),"/",$E(ADEVFM,2,3)
W ?45,X
W ?60,$J($P(ADEV(X),U,3),7,2)
Q
EOL I IOSL-$Y<10 D HEAD
Q
TOT S ADETITL="" W !! ; D LINE
W !?35,"Total Fee Charged: ",?59,$J(ADETCH,8,2)
W ! D LINE
Q
SIG W !!! S $P(X,"_",50)="" W X
W !,"Dentist Signature",?35,"Date"
Q
ADEATT4 ; IHS/HQT/MJL - ATTENDING DDS STMNT PT 4 ;11:42 AM [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;------->INIT
INIT USE IO
KILL ADELIN
SET $PIECE(ADELIN,"=",79)=""
SET ADEPAG=0
+1 ;------->D HEADER
+2 DO HEAD
+3 ;------->CARRIER NAME
+4 DO CAR
+5 ;------->PATIENT NAME
+6 DO PAT
+7 ;------->PROVIDER
+8 DO PROV
+9 ;------->PROCEDURES
+10 DO PROC
+11 ;------->TOTAL CHARGE
+12 DO TOT
+13 ;------->SIGNATURE
+14 DO SIG
+15 ;------->END
END ;
+1 DO ^%ZISC
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL ADEPAG
+4 QUIT
LINE WRITE $EXTRACT(ADELIN,1,40-($LENGTH(ADETITL)/2)),ADETITL,$EXTRACT(ADELIN,1,39-($LENGTH(ADETITL)/2))
QUIT
HEAD IF ADEPAG'=0
WRITE @IOF
SET ADEPAG=ADEPAG+1
SET ADETITL="ATTENDING DENTIST STATEMENT"
SET ADELIN=""
SET $PIECE(ADELIN," ",50)=""
IF ADEPAG>1
SET ADETITL=ADETITL_" Page "_ADEPAG
DO LINE
SET $Y=1
+1 IF ADEPAG>1
SET ADETITL="Patient: "_ADEPNM
DO LINE
+2 SET ADELIN=""
SET $PIECE(ADELIN,"=",79)=""
+3 QUIT
CAR SET ADETITL="Carrier Name and Address"
WRITE !!
DO LINE
+1 WRITE !,ADEINSN
SET ADENOD=^AUTNINS(ADEINS,0)
+2 WRITE !
WRITE $PIECE(ADENOD,U,2)
+3 WRITE !
WRITE $PIECE(ADENOD,U,3)
+4 IF +$PIECE(ADENOD,U,4)
IF $DATA(^DIC(5,$PIECE(ADENOD,U,4),0))
WRITE ?30,$PIECE(^DIC(5,$PIECE(ADENOD,U,4),0),U,2)
+5 WRITE ?40,$PIECE(ADENOD,U,5)
+6 QUIT
PAT SET ADETITL="Patient Name and Address"
WRITE !!
DO LINE
+1 WRITE !,ADEPNM
+2 SET ADENOD=""
IF ADEINSN'["MEDICAID"
IF ADEINSN'["MEDICARE"
IF ADEINSN'["RAILROAD RETIREMENT"
SET ADENOD=$ORDER(^AUPNPRVT(ADEPAT,11,"B",ADEINS,0))
SET ADENOD=^AUPNPRVT(ADEPAT,11,ADENOD,0)
+3 IF $PIECE(ADENOD,U,4)]""
IF $PIECE(ADENOD,U,5)]""
WRITE ?30,"Relationship to Sponsor: ",$PIECE(^AUTTRLSH($PIECE(ADENOD,U,5),0),U)
+4 IF $PIECE(ADENOD,U,4)]""
WRITE !,"Sponsor: ",$PIECE(ADENOD,U,4)
+5 IF '$DATA(^DPT(ADEPAT,.11))
WRITE !,"(Mailing Address Not Available)"
QUIT
+6 SET ADENOD=^DPT(ADEPAT,.11)
+7 WRITE !,$PIECE(ADENOD,U)
+8 WRITE !,$PIECE(ADENOD,U,4),?30,$PIECE(^DIC(5,$PIECE(ADENOD,U,5),0),U,2),?40,$PIECE(ADENOD,U,6)
+9 ;W !,"PATIENT CITY",?30,"STATE",?40,"ZIP"
+10 WRITE !!,"(Signature on File)"
+11 QUIT
PROV SET ADETITL="Dentist Name"
WRITE !!
DO LINE
+1 ;"DENTIST"
WRITE !,ADERDNM
+2 SET ADENOD=^AUTTLOC(DUZ(2),0)
+3 ;"DDS ADDRESS"
WRITE !,$PIECE(ADENOD,U,12)
+4 ;W !,"DDS CITY",?30,"STATE",?40,"ZIP"
+5 WRITE !,$PIECE(ADENOD,U,13),?30,$PIECE(^DIC(5,$PIECE(ADENOD,U,14),0),U,2),?40,$PIECE(ADENOD,U,15)
+6 ;"DDS SSN"
WRITE !,"Dentist SSN: ",$PIECE(^DIC(16,ADERDNMD,0),U,9)
+7 QUIT
PROC SET ADETITL="Treatment Provided"
WRITE !
DO LINE
+1 WRITE !,"Tooth",?10,"Description of Service",?35,"Date",?45,"Procedure",?60,"Fee"
SET ADETITL=""
WRITE !
DO LINE
+2 SET X=0
FOR J=0:0
SET X=$ORDER(ADEV(X))
IF X=""
QUIT
DO PROC1
DO EOL
+3 QUIT
PROC1 IF $PIECE(ADEV(X),U,3)<1
QUIT
+1 FOR K=1:1:$PIECE(ADEV(X),U)
DO PROC2
+2 QUIT
PROC2 WRITE !,$SELECT($PIECE($PIECE(ADEV(X),U,2),",",K)]"":^ADEOPS($PIECE($PIECE(ADEV(X),U,2),",",K),88),1:"")
+1 WRITE ?10,ADEDES(X)
+2 WRITE ?35,$EXTRACT(ADEVFM,4,5),"/",$EXTRACT(ADEVFM,6,7),"/",$EXTRACT(ADEVFM,2,3)
+3 WRITE ?45,X
+4 WRITE ?60,$JUSTIFY($PIECE(ADEV(X),U,3),7,2)
+5 QUIT
EOL IF IOSL-$Y<10
DO HEAD
+1 QUIT
TOT ; D LINE
SET ADETITL=""
WRITE !!
+1 WRITE !?35,"Total Fee Charged: ",?59,$JUSTIFY(ADETCH,8,2)
+2 WRITE !
DO LINE
+3 QUIT
SIG WRITE !!!
SET $PIECE(X,"_",50)=""
WRITE X
+1 WRITE !,"Dentist Signature",?35,"Date"
+2 QUIT
