DGREGDD.m

DGREGDD ;ALB/REW,TMK - REGISTRATION PATIENT FILE MUMPS X-REFS ; 28-MAR-06

 ;;5.3;Registration;**583,1015**;Aug 13, 1993;Build 21

 ;

 ; Calls to ^XUAF4: DBIA2171

 ;

SET(DFN,X) ; XREF SET STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)

 ; TRIGGERS THE FREE TEXT VALUE OF FLD .312 TO STATION#_STATION NAME

 Q:'$G(DFN)!($G(X)="")

 N DGROOT,DGNM,DGST,DGX,DGZ,Y

 S DGST=$$STA^XUAF4(X)

 D F4^XUAF4(DGST,.DGZ)

 S DGX="",DGNM=$G(DGZ("NAME"))

 S:DGST DGX=$E(DGST_DGNM,1,40)

 S DGROOT(2,DFN_",",.312)=DGX

 D FILE^DIE(,"DGROOT")

 Q

 ;

KILL(DFN) ; XREF KILL STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)

 ; TRIGGERS THE FREE TEXT VALUE OF FIELD .312 TO NULL (deletes it)

 Q:'$G(DFN)

 N DGROOT,X,Y

 S DGROOT(2,DFN_",",.312)="@"

 D FILE^DIE(,"DGROOT")

 Q

 ;

CFLTF(DGI) ;CLAIM FOLDER LOCATION screen of INSTITUTIONS with specific types

 ; DGI = facility (pointer to file 4)

 ; Returns 1 if valid facility type for facility ien DGI

 ; Returns 0 if invalid facility type for facility ien DGI

 N DGARR,DGX,OK,X,Y,Z

 S OK=0

 I $G(DGI)="" G CFLTFQ

 F Z="RO","RO&IC","RO-OC","RPC","M&ROC","M&ROC(M&RO)" S DGARR(Z)=""

 D F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")

 I $G(DGX("TYPE"))'="",$D(DGARR(DGX("TYPE"))) S OK=1

CFLTFQ Q OK

 ;

PFTF(DGI) ;PREFERRED FACILITY screens of INSTITUTIONS for valid facility types

 ; DGI = facility (pointer to file 4)

 ; Returns 1 if valid facility type for facility

 ; Returns 0 if invalid facility type for facility

 N DGARR,OK,X,Y,Z

 S OK=0

 I $G(DGI)="" G PFTFQ

 F Z="CBOC","HCS","HEALTHCARE","M&ROC","MOC","MORC","NETWORK","NHC","OC","OCMC","OCS","OPC","ORC","RO-OC","SATELLITE","SOC","VAMC","VANPH","VA ROSEBERG" S DGARR(Z)=""

 D F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")

 I $G(DGX("TYPE"))'="",$D(DGARR(DGX("TYPE"))) S OK=1

PFTFQ Q OK

 ;

DGREGDD   ;ALB/REW,TMK - REGISTRATION PATIENT FILE MUMPS X-REFS ; 28-MAR-06

 +1       ;;5.3;Registration;**583,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ; Calls to ^XUAF4: DBIA2171

 +4       ;

SET(DFN,X) ; XREF SET STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)

 +1       ; TRIGGERS THE FREE TEXT VALUE OF FLD .312 TO STATION#_STATION NAME

 +2        IF '$GET(DFN)!($GET(X)="")

               QUIT 

 +3        NEW DGROOT,DGNM,DGST,DGX,DGZ,Y

 +4        SET DGST=$$STA^XUAF4(X)

 +5        DO F4^XUAF4(DGST,.DGZ)

 +6        SET DGX=""

           SET DGNM=$GET(DGZ("NAME"))

 +7        IF DGST

               SET DGX=$EXTRACT(DGST_DGNM,1,40)

 +8        SET DGROOT(2,DFN_",",.312)=DGX

 +9        DO FILE^DIE(,"DGROOT")

 +10       QUIT 

 +11      ;

KILL(DFN) ; XREF KILL STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)

 +1       ; TRIGGERS THE FREE TEXT VALUE OF FIELD .312 TO NULL (deletes it)

 +2        IF '$GET(DFN)

               QUIT 

 +3        NEW DGROOT,X,Y

 +4        SET DGROOT(2,DFN_",",.312)="@"

 +5        DO FILE^DIE(,"DGROOT")

 +6        QUIT 

 +7       ;

CFLTF(DGI) ;CLAIM FOLDER LOCATION screen of INSTITUTIONS with specific types

 +1       ; DGI = facility (pointer to file 4)

 +2       ; Returns 1 if valid facility type for facility ien DGI

 +3       ; Returns 0 if invalid facility type for facility ien DGI

 +4        NEW DGARR,DGX,OK,X,Y,Z

 +5        SET OK=0

 +6        IF $GET(DGI)=""

               GOTO CFLTFQ

 +7        FOR Z="RO","RO&IC","RO-OC","RPC","M&ROC","M&ROC(M&RO)"

               SET DGARR(Z)=""

 +8        DO F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")

 +9        IF $GET(DGX("TYPE"))'=""

               IF $DATA(DGARR(DGX("TYPE")))

                   SET OK=1

CFLTFQ     QUIT OK

 +1       ;

PFTF(DGI) ;PREFERRED FACILITY screens of INSTITUTIONS for valid facility types

 +1       ; DGI = facility (pointer to file 4)

 +2       ; Returns 1 if valid facility type for facility

 +3       ; Returns 0 if invalid facility type for facility

 +4        NEW DGARR,OK,X,Y,Z

 +5        SET OK=0

 +6        IF $GET(DGI)=""

               GOTO PFTFQ

 +7        FOR Z="CBOC","HCS","HEALTHCARE","M&ROC","MOC","MORC","NETWORK","NHC","OC","OCMC","OCS","OPC","ORC","RO-OC","SATELLITE","SOC","VAMC","VANPH","VA ROSEBERG"

               SET DGARR(Z)=""

 +8        DO F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")

 +9        IF $GET(DGX("TYPE"))'=""

               IF $DATA(DGARR(DGX("TYPE")))

                   SET OK=1

PFTFQ      QUIT OK

 +1       ;