AVAPRVC.m

AVAPRVC ; OHPRD/DG - MUMPS CONDITIONAL ON PROVIDER FILE ; 27-MAY-1993

 ;;93.2;VA SUPPORT FILES;;JUL 01, 1993;Build 12

 ;FINDS OR CREATES GENERIC PROVIDER

 ;

LKUP S AVA("D")=$O(^DIC(7,"B",^UTILITY("DIFGFLD",$J,2),""))

 I AVA("D"),$D(^DIC(7,AVA("D"),9999999)) S AVA("D")=^(9999999)

 E  G XIT ; No Code For Provider Class (Discipline)

 S AVA("AFFIL")=$$INTSET^XBFUNC(6,9999999.01,^UTILITY("DIFGFLD",$J,9999999.01))

 S AVA("ADP")=AVA("AFFIL")_AVA("D")_999

 I $D(^DIC(6,"GIHS",AVA("ADP"))) S Y=$O(^(AVA("ADP"),""))

 E  D CREATE

XIT K AVA

 Q

 ;

CREATE ; Creates New Generic Provider

 NEW DIC,DR,DA,X

 S X=^UTILITY("DIFGFLD",$J,2)_","_$S(^UTILITY("DIFGFLD",$J,9999999.01)'[638:^(9999999.01),1:"TRIBAL CONTRACT")

 S DIC("DR")="",DIADD=1,DLAYGO=16,DIC="^DIC(16,",DIC(0)="FML" D ^DIC K DIC,DR,DA,DIADD I Y=-1 G X1

 S AVA("PRSN")=+Y

 S X="`"_+Y,DIC="^DIC(6,",DLAYGO=6,DIC(0)="FML",DIC("DR")="2///"_^UTILITY("DIFGFLD",$J,2)_";9999999.01///"_^UTILITY("DIFGFLD",$J,9999999.01)_";9999999.02////999" D ^DIC K DIC,DA,DR

 I Y=-1 S DA=AVA("PRSN"),DIK="^DIC(16," D ^DIK K DIK,DA

 I Y>0 S Y=+Y

X1 Q

 ;

AVAPRVC   ; OHPRD/DG - MUMPS CONDITIONAL ON PROVIDER FILE ; 27-MAY-1993

 +1       ;;93.2;VA SUPPORT FILES;;JUL 01, 1993;Build 12

 +2       ;FINDS OR CREATES GENERIC PROVIDER

 +3       ;

LKUP       SET AVA("D")=$ORDER(^DIC(7,"B",^UTILITY("DIFGFLD",$JOB,2),""))

 +1        IF AVA("D")

               IF $DATA(^DIC(7,AVA("D"),9999999))

                   SET AVA("D")=^(9999999)

 +2       ; No Code For Provider Class (Discipline)

          IF '$TEST

               GOTO XIT

 +3        SET AVA("AFFIL")=$$INTSET^XBFUNC(6,9999999.01,^UTILITY("DIFGFLD",$JOB,9999999.01))

 +4        SET AVA("ADP")=AVA("AFFIL")_AVA("D")_999

 +5        IF $DATA(^DIC(6,"GIHS",AVA("ADP")))

               SET Y=$ORDER(^(AVA("ADP"),""))

 +6       IF '$TEST

               DO CREATE

XIT        KILL AVA

 +1        QUIT 

 +2       ;

CREATE    ; Creates New Generic Provider

 +1        NEW DIC,DR,DA,X

 +2        SET X=^UTILITY("DIFGFLD",$JOB,2)_","_$SELECT(^UTILITY("DIFGFLD",$JOB,9999999.01)'[638:^(9999999.01),1:"TRIBAL CONTRACT")

 +3        SET DIC("DR")=""

           SET DIADD=1

           SET DLAYGO=16

           SET DIC="^DIC(16,"

           SET DIC(0)="FML"

           DO ^DIC

           KILL DIC,DR,DA,DIADD

           IF Y=-1

               GOTO X1

 +4        SET AVA("PRSN")=+Y

 +5        SET X="`"_+Y

           SET DIC="^DIC(6,"

           SET DLAYGO=6

           SET DIC(0)="FML"

           SET DIC("DR")="2///"_^UTILITY("DIFGFLD",$JOB,2)_";9999999.01///"_^UTILITY("DIFGFLD",$JOB,9999999.01)_";9999999.02////999"

           DO ^DIC

           KILL DIC,DA,DR

 +6        IF Y=-1

               SET DA=AVA("PRSN")

               SET DIK="^DIC(16,"

               DO ^DIK

               KILL DIK,DA

 +7        IF Y>0

               SET Y=+Y

X1         QUIT 

 +1       ;