- ADEATT ; IHS/HQT/MJL - ATTENDING DDS STMT I ;12:31 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- ;------->INIT
- CTRL S $P(ADELIN,"$",79)="",ADETITL="ATTENDING DENTIST STATEMENT"
- S ADEFAST=0,ADEINT=0
- ;------->PATIENT LOOKUP
- S ADENEWVS=0,ADEDIR=1,ADECON=0,AUPNLK("ALL")=""
- D PTLOOK G:Y<1 END
- VIS ;------->VISIT LOOKUP
- D ^ADEGRL2 G:'Y CTRL I ADENEWVS W " ??",*7 G VIS
- D HRN^ADEGRL3
- ;------->LOAD LOCALS
- S ADECON=1,ADEDIR=0 D MOD^ADEGRL
- ;------->LOAD FEES BASED ON ^ADEFEE
- INT D FEE^ADEATT2 S ADETCHF=0
- D LIST^ADEGRL3
- ;------->PROMPT FOR CARRIER INFO (ENTER HERE INTERNALLY)
- D INS G:Y<1 RET
- ;------->PROMPT FOR FEES
- D ^ADEATT2 G:'Y RET
- ;------->UPDATE INSURANCE ELIGIBLE FILE
- I ADEINSN'["MEDICAID",ADEINSN'["MEDICARE",ADEINSN'["RAILROAD RETIREMENT" D ^ADEATT3
- ;------->DEVICE SELECTION
- S %ZIS="Q" D ^%ZIS G:POP RET I $D(IO("Q")) K IO("Q") D QUE W !,"REQUEST QUEUED." G RET
- ;------->PRINT STATEMENT
- D ^ADEATT4
- RET ;------->RETURN
- I 'ADEINT D END G CTRL
- I ADEINT D ENDINT Q
- END ;------->END
- D END^ADEGRL
- K ADEINS,ADEINSN,ADENOD,ADEINT
- Q
- PTLOOK ;
- K DIC,Y,ADEPAT D ^ADECLS R "Select Dental Patient Name: ",X:DTIME
- I '$T!(X="")!(X["^") S Y=-1 Q
- I X["?" S XQH="ADE-DVIS-PATIENT" D EN^XQH K XQH G PTLOOK
- S DIC="^AUPNPAT(",DIC(0)="MEZQ" D ^DIC K DIC
- G:Y<1 PTLOOK
- S ADEPAT=$P(Y,U)
- S Y=1 Q
- INS K DIC,Y R !,"Select INSURER: ",X:DTIME
- I '$T!(X="")!(X["^") S Y=-1 Q
- S DIC="^AUTNINS(",DIC(0)="MEZQ"
- I X["?" S X="?" D ^ADECLS,^DIC R "Press `Return' to continue: ",X:DTIME D LIST^ADEGRL3 G INS
- S DIC="^AUTNINS(",DIC(0)="MEZQ"
- D ^DIC K DIC
- G:Y<1 INS
- S ADEINS=+Y,ADEINSN=$P(Y,U,2)
- S Y=1 Q
- INS2 ;Not allowed to edit the Insurer file
- Q
- S Y=1 D INS3
- I 'ADEDIT S Y=1 Q
- W !?5,"Please provide Address information for this insurer (`^' to abort):"
- S DIE="^AUTNINS(",DR=".02;.03;.04;.05",DA=ADEINS,DIE("NO^")="OUTOK"
- D ^DIE K DR,DIE,DA
- D INS3 I ADEDIT S Y=0 W !?5,"***INCOMPLETE INSURER ADDRESS -- ABORTED***" H 1 Q
- S Y=1 Q
- INS3 S ADEDIT=0 F J=2:1:5 I $P(^AUTNINS(ADEINS,0),U,J)="" S ADEDIT=1
- Q
- DUZ1 Q
- DUZ2 Q
- ;
- QUE S ZTRTN="^ADEATT4",ZTDESC="ATTENDING DDS STATEMENT"
- F Z="ADEDES(","ADEINS","ADEINSN","ADEPAT","ADEPNM","ADERDNM","ADERDNMD","ADETCH","ADEV(","ADEVFM" S ZTSAVE(Z)=""
- D ^%ZTLOAD
- Q
- EN ;EP
- N ADECON,ADEDIR,ADELIN,ADEFAST,ADETCHF,ADETITL
- S ADECON=1,ADEDIR=0,ADEFAST=0,ADEINT=1
- S $P(ADELIN,"$",79)="",ADETITL="ATTENDING DENTIST STATEMENT"
- G INT
- ENDINT S X=0 F J=0:0 S X=$O(ADEV(X)) Q:X="" S $P(ADEV(X),U,3)=""
- K ADEDIR,ADECON,ADELIN,ADEFAST,ADETCHF,ADEINT,ADEINS,ADEINSN,ADENOD
- Q
- ADEATT ; IHS/HQT/MJL - ATTENDING DDS STMT I ;12:31 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 ;------->INIT
- CTRL SET $PIECE(ADELIN,"$",79)=""
- SET ADETITL="ATTENDING DENTIST STATEMENT"
- +1 SET ADEFAST=0
- SET ADEINT=0
- +2 ;------->PATIENT LOOKUP
- +3 SET ADENEWVS=0
- SET ADEDIR=1
- SET ADECON=0
- SET AUPNLK("ALL")=""
- +4 DO PTLOOK
- IF Y<1
- GOTO END
- VIS ;------->VISIT LOOKUP
- +1 DO ^ADEGRL2
- IF 'Y
- GOTO CTRL
- IF ADENEWVS
- WRITE " ??",*7
- GOTO VIS
- +2 DO HRN^ADEGRL3
- +3 ;------->LOAD LOCALS
- +4 SET ADECON=1
- SET ADEDIR=0
- DO MOD^ADEGRL
- +5 ;------->LOAD FEES BASED ON ^ADEFEE
- INT DO FEE^ADEATT2
- SET ADETCHF=0
- +1 DO LIST^ADEGRL3
- +2 ;------->PROMPT FOR CARRIER INFO (ENTER HERE INTERNALLY)
- +3 DO INS
- IF Y<1
- GOTO RET
- +4 ;------->PROMPT FOR FEES
- +5 DO ^ADEATT2
- IF 'Y
- GOTO RET
- +6 ;------->UPDATE INSURANCE ELIGIBLE FILE
- +7 IF ADEINSN'["MEDICAID"
- IF ADEINSN'["MEDICARE"
- IF ADEINSN'["RAILROAD RETIREMENT"
- DO ^ADEATT3
- +8 ;------->DEVICE SELECTION
- +9 SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO RET
- IF $DATA(IO("Q"))
- KILL IO("Q")
- DO QUE
- WRITE !,"REQUEST QUEUED."
- GOTO RET
- +10 ;------->PRINT STATEMENT
- +11 DO ^ADEATT4
- RET ;------->RETURN
- +1 IF 'ADEINT
- DO END
- GOTO CTRL
- +2 IF ADEINT
- DO ENDINT
- QUIT
- END ;------->END
- +1 DO END^ADEGRL
- +2 KILL ADEINS,ADEINSN,ADENOD,ADEINT
- +3 QUIT
- PTLOOK ;
- +1 KILL DIC,Y,ADEPAT
- DO ^ADECLS
- READ "Select Dental Patient Name: ",X:DTIME
- +2 IF '$TEST!(X="")!(X["^")
- SET Y=-1
- QUIT
- +3 IF X["?"
- SET XQH="ADE-DVIS-PATIENT"
- DO EN^XQH
- KILL XQH
- GOTO PTLOOK
- +4 SET DIC="^AUPNPAT("
- SET DIC(0)="MEZQ"
- DO ^DIC
- KILL DIC
- +5 IF Y<1
- GOTO PTLOOK
- +6 SET ADEPAT=$PIECE(Y,U)
- +7 SET Y=1
- QUIT
- INS KILL DIC,Y
- READ !,"Select INSURER: ",X:DTIME
- +1 IF '$TEST!(X="")!(X["^")
- SET Y=-1
- QUIT
- +2 SET DIC="^AUTNINS("
- SET DIC(0)="MEZQ"
- +3 IF X["?"
- SET X="?"
- DO ^ADECLS
- DO ^DIC
- READ "Press `Return' to continue: ",X:DTIME
- DO LIST^ADEGRL3
- GOTO INS
- +4 SET DIC="^AUTNINS("
- SET DIC(0)="MEZQ"
- +5 DO ^DIC
- KILL DIC
- +6 IF Y<1
- GOTO INS
- +7 SET ADEINS=+Y
- SET ADEINSN=$PIECE(Y,U,2)
- +8 SET Y=1
- QUIT
- INS2 ;Not allowed to edit the Insurer file
- +1 QUIT
- +2 SET Y=1
- DO INS3
- +3 IF 'ADEDIT
- SET Y=1
- QUIT
- +4 WRITE !?5,"Please provide Address information for this insurer (`^' to abort):"
- +5 SET DIE="^AUTNINS("
- SET DR=".02;.03;.04;.05"
- SET DA=ADEINS
- SET DIE("NO^")="OUTOK"
- +6 DO ^DIE
- KILL DR,DIE,DA
- +7 DO INS3
- IF ADEDIT
- SET Y=0
- WRITE !?5,"***INCOMPLETE INSURER ADDRESS -- ABORTED***"
- HANG 1
- QUIT
- +8 SET Y=1
- QUIT
- INS3 SET ADEDIT=0
- FOR J=2:1:5
- IF $PIECE(^AUTNINS(ADEINS,0),U,J)=""
- SET ADEDIT=1
- +1 QUIT
- DUZ1 QUIT
- DUZ2 QUIT
- +1 ;
- QUE SET ZTRTN="^ADEATT4"
- SET ZTDESC="ATTENDING DDS STATEMENT"
- +1 FOR Z="ADEDES(","ADEINS","ADEINSN","ADEPAT","ADEPNM","ADERDNM","ADERDNMD","ADETCH","ADEV(","ADEVFM"
- SET ZTSAVE(Z)=""
- +2 DO ^%ZTLOAD
- +3 QUIT
- EN ;EP
- +1 NEW ADECON,ADEDIR,ADELIN,ADEFAST,ADETCHF,ADETITL
- +2 SET ADECON=1
- SET ADEDIR=0
- SET ADEFAST=0
- SET ADEINT=1
- +3 SET $PIECE(ADELIN,"$",79)=""
- SET ADETITL="ATTENDING DENTIST STATEMENT"
- +4 GOTO INT
- ENDINT SET X=0
- FOR J=0:0
- SET X=$ORDER(ADEV(X))
- IF X=""
- QUIT
- SET $PIECE(ADEV(X),U,3)=""
- +1 KILL ADEDIR,ADECON,ADELIN,ADEFAST,ADETCHF,ADEINT,ADEINS,ADEINSN,ADENOD
- +2 QUIT
