ADEGRL1 ; IHS/HQT/MJL - DENTAL ENTRY PART 2 ;12:36 PM [ 03/26/2003 11:22 AM ]
;;6.0;ADE;**26**;APRIL 1999;Build 13
;IHS/MFD FAC SUBRTN REDONE FOR MULTI-FACILITY LOOKUP PER DG/OHPRD
;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
FAC ;EP
W !,"Select Location of Encounter: ",$S($D(ADEFAC):ADEFAC_"// ",1:"") R X:DTIME
K DIC,Y S DIC="^ADEPARAM(DUZ(2),1,",DIC(0)="EZMQ" D ^DIC K DIC Q:"^"[X
I Y<0 W !,*7,"Only facilities entered into the LOCAL FACILITY field of the DENTAL SITE",!,"PARAMETERS file may be selected." G FAC
S ADETMP=+Y(0)
K AUPNLK("ALL") D UNIV^ADEGRL0 G:'Y FAC
S (ADEFACD,DUZ(2))=+Y(0),ADEFAC=Y(0,0)
Q
REPD K DIC,Y S DIC=6,DIC("A")="Select Attending Dentist: ",DIC(0)="MAEZQ"
S DIC("S")="D SCRN1^ADEGRL1"
S:$D(ADEREP) DIC("B")=ADEREP D ^DIC K DIC Q:Y=-1
S (ADEREPD)=$P(Y,U),(ADEREP)=Y(0,0)
Q
;I $D(^DIC(6,Y,9999999)),$P(^DIC(6,Y,9999999),U)=$S(ADECON:"2",1:"1"),$P(^DIC(6,Y,0),U,4)]"",^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=52,$P(^DIC(16,Y,0),U,9)]""
SCRN1 I $D(^DIC(6,Y,9999999)),$S(ADECON:"2",1:"138")[$P(^DIC(6,Y,9999999),U),$P(^DIC(6,Y,0),U,4)]"",+^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=52,$P(^DIC(16,Y,0),U,9)]""
E Q
I $S('$D(^DIC(6,Y,"I")):1,^DIC(6,Y,"I")']"":1,1:0)
Q
;
SCRN2 I $P(^DIC(6,Y,0),U,4)]"",$D(^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)),+^(9999999)=46
E Q
I $S('$D(^DIC(6,Y,"I")):1,^DIC(6,Y,"I")']"":1,1:0)
Q
LINE W $E(ADELIN,1,40-($L(ADETITL)/2)),ADETITL,$E(ADELIN,1,39-($L(ADETITL)/2)) Q
RESET ;EP
D ^ADECLS
S:'$D(ADEPRO) (ADEPRO,ADEPROD)=""
S:'$D(ADEREP) (ADEREP,ADEREPD)=""
S:ADEDIR&(ADEREP="") ADEREPD=$P(^ADEPARAM($P(^AUTTSITE(1,0),U),0),U,3)
I ADEDIR,ADEREPD]"" S Y=ADEREPD D SCRN1 S:'$T (ADEREPD,ADEREP)=""
S:ADEREPD]"" ADEREP=$P(^DIC(16,ADEREPD,0),U)
RESET3 N DIR
;S ADEFACD=$O(^ADEPARAM(0)) ;IHS/NPO/FBD-3/26/2003-ORIGINAL LINE - COMMENTED OUT
S ADEFACD=DUZ(2) ;IHS/NPO/FBD-3/26/2003-PICKING THE RIGHT FACILITY
S DIR(0)="PO^ADEPARAM(ADEFACD,1,:QEMZ"
S DIR("A")="Select Location of Encounter"
; ENTER A LOCATION
S DIR("A",1)="DENTAL VISIT DATA ENTRY STARTUP SCREEN"
S DIR("A",2)=""
S DIR("A",3)="The LOCATION OF ENCOUNTER selected from those listed below"
S DIR("A",4)="applies to every dental visit until you change it to another location. You"
S DIR("A",4.1)="may change the LOCATION before selecting the patient name for each visit."
S DIR("A",5)=""
S DIR("A",6)="DENTAL CARE PROVIDERS are selected from the CURRENT VISIT"
S DIR("A",7)="ENTRIES TABLE. Provider names can be edited to apply only to the"
S DIR("A",8)="current visit data or to subsequent visits entered during this session."
S DIR("A",9)=""
;/IHS/OIT/GAB 12.2014 Changed below for 2015 Code Updates patch #26
S DIR("A",10)="*************Notice**************"
S DIR("A",11)="Cancelled and Broken appointment codes have been changed to the following: "
S DIR("A",12)=" Missed Appointment (9986) has replaced code (9130)"
S DIR("A",13)=" Cancelled Appointment (9987) has replaced code (9140)"
S DIR("A",14)=""
S DIR("A",15)=""
RESET4 D ^DIR
I $$HAT()!(X="")!(X[U) K DIR Q ;S Y=-1 Q
I Y<1 G RESET4
S ADEFACD=$P(Y,U,2),ADEFAC=Y(0,0) ;Q ;,Y=1 Q
I '$$UNIV^ADEGRL0(ADEFACD) G RESET3
Q
;
HAT() ;EP - Returns 1 if dtout,duout,dirout
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q 1
Q 0
PTLOOK ;EP
K DIC,Y,ADEPAT
W !,"Enter the Health Record Number of a Patient: "
R 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)
I $D(^ADEUTL("ADELOCK",ADEPAT)) W !!,"PATIENT'S RECORD CURRENTLY BEING EDITED. TRY LATER." H 3 K ADEPAT,X G PTLOOK
S ^ADEUTL("ADELOCK",ADEPAT)=""
S Y=1 Q
ADEGRL1 ; IHS/HQT/MJL - DENTAL ENTRY PART 2 ;12:36 PM [ 03/26/2003 11:22 AM ]
+1 ;;6.0;ADE;**26**;APRIL 1999;Build 13
+2 ;IHS/MFD FAC SUBRTN REDONE FOR MULTI-FACILITY LOOKUP PER DG/OHPRD
+3 ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
FAC ;EP
+1 WRITE !,"Select Location of Encounter: ",$SELECT($DATA(ADEFAC):ADEFAC_"// ",1:"")
READ X:DTIME
+2 KILL DIC,Y
SET DIC="^ADEPARAM(DUZ(2),1,"
SET DIC(0)="EZMQ"
DO ^DIC
KILL DIC
IF "^"[X
QUIT
+3 IF Y<0
WRITE !,*7,"Only facilities entered into the LOCAL FACILITY field of the DENTAL SITE",!,"PARAMETERS file may be selected."
GOTO FAC
+4 SET ADETMP=+Y(0)
+5 KILL AUPNLK("ALL")
DO UNIV^ADEGRL0
IF 'Y
GOTO FAC
+6 SET (ADEFACD,DUZ(2))=+Y(0)
SET ADEFAC=Y(0,0)
+7 QUIT
REPD KILL DIC,Y
SET DIC=6
SET DIC("A")="Select Attending Dentist: "
SET DIC(0)="MAEZQ"
+1 SET DIC("S")="D SCRN1^ADEGRL1"
+2 IF $DATA(ADEREP)
SET DIC("B")=ADEREP
DO ^DIC
KILL DIC
IF Y=-1
QUIT
+3 SET (ADEREPD)=$PIECE(Y,U)
SET (ADEREP)=Y(0,0)
+4 QUIT
+5 ;I $D(^DIC(6,Y,9999999)),$P(^DIC(6,Y,9999999),U)=$S(ADECON:"2",1:"1"),$P(^DIC(6,Y,0),U,4)]"",^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=52,$P(^DIC(16,Y,0),U,9)]""
SCRN1 IF $DATA(^DIC(6,Y,9999999))
IF $SELECT(ADECON:"2",1:"138")[$PIECE(^DIC(6,Y,9999999),U)
IF $PIECE(^DIC(6,Y,0),U,4)]""
IF +^DIC(7,$PIECE(^DIC(6,Y,0),U,4),9999999)=52
IF $PIECE(^DIC(16,Y,0),U,9)]""
+1 IF '$TEST
QUIT
+2 IF $SELECT('$DATA(^DIC(6,Y,"I")):1,^DIC(6,Y,"I")']"":1,1:0)
+3 QUIT
+4 ;
SCRN2 IF $PIECE(^DIC(6,Y,0),U,4)]""
IF $DATA(^DIC(7,$PIECE(^DIC(6,Y,0),U,4),9999999))
IF +^(9999999)=46
+1 IF '$TEST
QUIT
+2 IF $SELECT('$DATA(^DIC(6,Y,"I")):1,^DIC(6,Y,"I")']"":1,1:0)
+3 QUIT
LINE WRITE $EXTRACT(ADELIN,1,40-($LENGTH(ADETITL)/2)),ADETITL,$EXTRACT(ADELIN,1,39-($LENGTH(ADETITL)/2))
QUIT
RESET ;EP
+1 DO ^ADECLS
+2 IF '$DATA(ADEPRO)
SET (ADEPRO,ADEPROD)=""
+3 IF '$DATA(ADEREP)
SET (ADEREP,ADEREPD)=""
+4 IF ADEDIR&(ADEREP="")
SET ADEREPD=$PIECE(^ADEPARAM($PIECE(^AUTTSITE(1,0),U),0),U,3)
+5 IF ADEDIR
IF ADEREPD]""
SET Y=ADEREPD
DO SCRN1
IF '$TEST
SET (ADEREPD,ADEREP)=""
+6 IF ADEREPD]""
SET ADEREP=$PIECE(^DIC(16,ADEREPD,0),U)
RESET3 NEW DIR
+1 ;S ADEFACD=$O(^ADEPARAM(0)) ;IHS/NPO/FBD-3/26/2003-ORIGINAL LINE - COMMENTED OUT
+2 ;IHS/NPO/FBD-3/26/2003-PICKING THE RIGHT FACILITY
SET ADEFACD=DUZ(2)
+3 SET DIR(0)="PO^ADEPARAM(ADEFACD,1,:QEMZ"
+4 SET DIR("A")="Select Location of Encounter"
+5 ; ENTER A LOCATION
+6 SET DIR("A",1)="DENTAL VISIT DATA ENTRY STARTUP SCREEN"
+7 SET DIR("A",2)=""
+8 SET DIR("A",3)="The LOCATION OF ENCOUNTER selected from those listed below"
+9 SET DIR("A",4)="applies to every dental visit until you change it to another location. You"
+10 SET DIR("A",4.1)="may change the LOCATION before selecting the patient name for each visit."
+11 SET DIR("A",5)=""
+12 SET DIR("A",6)="DENTAL CARE PROVIDERS are selected from the CURRENT VISIT"
+13 SET DIR("A",7)="ENTRIES TABLE. Provider names can be edited to apply only to the"
+14 SET DIR("A",8)="current visit data or to subsequent visits entered during this session."
+15 SET DIR("A",9)=""
+16 ;/IHS/OIT/GAB 12.2014 Changed below for 2015 Code Updates patch #26
+17 SET DIR("A",10)="*************Notice**************"
+18 SET DIR("A",11)="Cancelled and Broken appointment codes have been changed to the following: "
+19 SET DIR("A",12)=" Missed Appointment (9986) has replaced code (9130)"
+20 SET DIR("A",13)=" Cancelled Appointment (9987) has replaced code (9140)"
+21 SET DIR("A",14)=""
+22 SET DIR("A",15)=""
RESET4 DO ^DIR
+1 ;S Y=-1 Q
IF $$HAT()!(X="")!(X[U)
KILL DIR
QUIT
+2 IF Y<1
GOTO RESET4
+3 ;Q ;,Y=1 Q
SET ADEFACD=$PIECE(Y,U,2)
SET ADEFAC=Y(0,0)
+4 IF '$$UNIV^ADEGRL0(ADEFACD)
GOTO RESET3
+5 QUIT
+6 ;
HAT() ;EP - Returns 1 if dtout,duout,dirout
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT 1
+2 QUIT 0
PTLOOK ;EP
+1 KILL DIC,Y,ADEPAT
+2 WRITE !,"Enter the Health Record Number of a Patient: "
+3 READ X:DTIME
+4 IF '$TEST!(X="")!(X["^")
SET Y=-1
QUIT
+5 IF X["?"
SET XQH="ADE-DVIS-PATIENT"
DO EN^XQH
KILL XQH
GOTO PTLOOK
+6 SET DIC="^AUPNPAT("
SET DIC(0)="MEZQ"
DO ^DIC
KILL DIC
+7 IF Y<1
GOTO PTLOOK
+8 SET ADEPAT=$PIECE(Y,U)
+9 IF $DATA(^ADEUTL("ADELOCK",ADEPAT))
WRITE !!,"PATIENT'S RECORD CURRENTLY BEING EDITED. TRY LATER."
HANG 3
KILL ADEPAT,X
GOTO PTLOOK
+10 SET ^ADEUTL("ADELOCK",ADEPAT)=""
+11 SET Y=1
QUIT
