ADEGRL0.m

ADEGRL0 ; IHS/HQT/MJL  - DENTAL ENTRY PART 1.5 ;04:55 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

INIT ;EP

 S Y=0

 I '$D(ADEDIR) S ADEDIR=1,ADECON=0

 I '$D(DUZ(2)) W !!,"SIGN-ON FACILITY NOT SET IN USER FILE.  CONTACT SITE MANAGER" Q

 S ^ADEUTL($J,"DUZ2")=DUZ(2)

 D ^XBKVAR I '$D(DUZ(2))!(DUZ(2)="") W !,"DIVISION NOT SET IN USER FILE -- CONTACT SITE MANAGER OR ISC" Q

 I DUZ(2)=0 S DUZ(2)=+^AUTTSITE(1,0) ;Reset to RPMS SITE

 I '$D(^ADEPARAM(+^AUTTSITE(1,0),0)) D WARN(+^AUTTSITE(1,0)) Q

 I '$D(^ADEPARAM(DUZ(2),0)) D WARN(DUZ(2)) Q

 I '$P(^ADEPARAM(DUZ(2),0),U)!($P(^(0),U,2)="")!($P(^(0),U,4)="")!($P(^(0),U,5)="")!($P(^(0),U,6)="")!('$P(^(0),U,7))!('$P(^(0),U,8))!($P(^(0),U,9)="") D WARN(DUZ(2)) Q

 I $P(^AUTTSITE(1,0),U,13)="" W !,*7,"UNIVERSAL LOOKUP FOR VISITS field in the RPMS SITE file",!,"has no entry. Contact your site manager." Q

 I '$D(DUZ(0)) W !,"FileMan Access Undefined.  Contact site manger." Q

 I DUZ(0)'="@",DUZ(0)'["M"!(DUZ(0)'["[") W !,"FileMan Access denied.  Contact site manager." Q

 K ADELIN S ADEFAST=0,$P(ADELIN,"-",79)=""

 S Y=1

 Q

UNIV(ADEFACD) ;EP - Returns 0 if local facility has no entry in UNIVERSAL LOOKUP

 ;;otw, returns 1 and resets DUZ(2) to dfn of Local Facility

 ;S Y=0

 ;S ADEDUZ(2)=DUZ(2),ADETMP=DUZ(2)

 N ADEDFN,ADESITE

 S ADESITE=+^AUTTSITE(1,0)

 I '$D(^ADEPARAM("AB",ADEFACD)) D WARN(ADEFACD) Q 0

 I '$D(^ADEPARAM("AB",ADEFACD,ADESITE)) D WARN(ADEFACD) Q 0

 S ADEDFN=$O(^ADEPARAM("AB",ADEFACD,ADESITE,0))

 I $P(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2)']"" W !,*7,"UNIVERSAL LOOKUP field value for this local facility not entered." Q 0

 K AUPNLK("ALL")

 I $P(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2) S AUPNLK("ALL")=""

 S DUZ(2)=ADEFACD

 Q 1

 ;

WARN(ADEFACD) ;

 W *7,!!,"Dental Site Parameter File has not been set up properly or fully"

 I ADEFACD]"",$D(^AUTTLOC(ADEFACD,0)) W !,"for ",$P(^AUTTLOC(ADEFACD,0),U,2)

 W ".",!,"Consult the DDS Documentation, the Help Frames, or your Site Manager.",!!

 H 1

 Q

ADEGRL0   ; IHS/HQT/MJL  - DENTAL ENTRY PART 1.5 ;04:55 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

INIT      ;EP

 +1        SET Y=0

 +2        IF '$DATA(ADEDIR)

               SET ADEDIR=1

               SET ADECON=0

 +3        IF '$DATA(DUZ(2))

               WRITE !!,"SIGN-ON FACILITY NOT SET IN USER FILE.  CONTACT SITE MANAGER"

               QUIT 

 +4        SET ^ADEUTL($JOB,"DUZ2")=DUZ(2)

 +5        DO ^XBKVAR

           IF '$DATA(DUZ(2))!(DUZ(2)="")

               WRITE !,"DIVISION NOT SET IN USER FILE -- CONTACT SITE MANAGER OR ISC"

               QUIT 

 +6       ;Reset to RPMS SITE

           IF DUZ(2)=0

               SET DUZ(2)=+^AUTTSITE(1,0)

 +7        IF '$DATA(^ADEPARAM(+^AUTTSITE(1,0),0))

               DO WARN(+^AUTTSITE(1,0))

               QUIT 

 +8        IF '$DATA(^ADEPARAM(DUZ(2),0))

               DO WARN(DUZ(2))

               QUIT 

 +9        IF '$PIECE(^ADEPARAM(DUZ(2),0),U)!($PIECE(^(0),U,2)="")!($PIECE(^(0),U,4)="")!($PIECE(^(0),U,5)="")!($PIECE(^(0),U,6)="")!('$PIECE(^(0),U,7))!('$PIECE(^(0),U,8))!($PIECE(^(0),U,9)="")

               DO WARN(DUZ(2))

               QUIT 

 +10       IF $PIECE(^AUTTSITE(1,0),U,13)=""

               WRITE !,*7,"UNIVERSAL LOOKUP FOR VISITS field in the RPMS SITE file",!,"has no entry. Contact your site manager."

               QUIT 

 +11       IF '$DATA(DUZ(0))

               WRITE !,"FileMan Access Undefined.  Contact site manger."

               QUIT 

 +12       IF DUZ(0)'="@"

               IF DUZ(0)'["M"!(DUZ(0)'["[")

                   WRITE !,"FileMan Access denied.  Contact site manager."

                   QUIT 

 +13       KILL ADELIN

           SET ADEFAST=0

           SET $PIECE(ADELIN,"-",79)=""

 +14       SET Y=1

 +15       QUIT 

UNIV(ADEFACD) ;EP - Returns 0 if local facility has no entry in UNIVERSAL LOOKUP

 +1       ;;otw, returns 1 and resets DUZ(2) to dfn of Local Facility

 +2       ;S Y=0

 +3       ;S ADEDUZ(2)=DUZ(2),ADETMP=DUZ(2)

 +4        NEW ADEDFN,ADESITE

 +5        SET ADESITE=+^AUTTSITE(1,0)

 +6        IF '$DATA(^ADEPARAM("AB",ADEFACD))

               DO WARN(ADEFACD)

               QUIT 0

 +7        IF '$DATA(^ADEPARAM("AB",ADEFACD,ADESITE))

               DO WARN(ADEFACD)

               QUIT 0

 +8        SET ADEDFN=$ORDER(^ADEPARAM("AB",ADEFACD,ADESITE,0))

 +9        IF $PIECE(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2)']""

               WRITE !,*7,"UNIVERSAL LOOKUP field value for this local facility not entered."

               QUIT 0

 +10       KILL AUPNLK("ALL")

 +11       IF $PIECE(^ADEPARAM(ADESITE,1,ADEDFN,0),U,2)

               SET AUPNLK("ALL")=""

 +12       SET DUZ(2)=ADEFACD

 +13       QUIT 1

 +14      ;

WARN(ADEFACD) ;

 +1        WRITE *7,!!,"Dental Site Parameter File has not been set up properly or fully"

 +2        IF ADEFACD]""

               IF $DATA(^AUTTLOC(ADEFACD,0))

                   WRITE !,"for ",$PIECE(^AUTTLOC(ADEFACD,0),U,2)

 +3        WRITE ".",!,"Consult the DDS Documentation, the Help Frames, or your Site Manager.",!!

 +4        HANG 1

 +5        QUIT