DGREGDD ;ALB/REW,TMK - REGISTRATION PATIENT FILE MUMPS X-REFS ; 28-MAR-06
;;5.3;Registration;**583**;Aug 13, 1993;Build 20
;
; 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGDD 1802 printed Sep 23, 2025@20:30:50 Page 2
DGREGDD ;ALB/REW,TMK - REGISTRATION PATIENT FILE MUMPS X-REFS ; 28-MAR-06
+1 ;;5.3;Registration;**583**;Aug 13, 1993;Build 20
+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 ;
