source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREGDD.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1DGREGDD ;ALB/REW,TMK - REGISTRATION PATIENT FILE MUMPS X-REFS ; 28-MAR-06
2 ;;5.3;Registration;**583**;Aug 13, 1993;Build 20
3 ;
4 ; Calls to ^XUAF4: DBIA2171
5 ;
6SET(DFN,X) ; XREF SET STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)
7 ; TRIGGERS THE FREE TEXT VALUE OF FLD .312 TO STATION#_STATION NAME
8 Q:'$G(DFN)!($G(X)="")
9 N DGROOT,DGNM,DGST,DGX,DGZ,Y
10 S DGST=$$STA^XUAF4(X)
11 D F4^XUAF4(DGST,.DGZ)
12 S DGX="",DGNM=$G(DGZ("NAME"))
13 S:DGST DGX=$E(DGST_DGNM,1,40)
14 S DGROOT(2,DFN_",",.312)=DGX
15 D FILE^DIE(,"DGROOT")
16 Q
17 ;
18KILL(DFN) ; XREF KILL STATEMENT FOR PATIENT, CLAIM FOLDER LOCATION (#2,.314)
19 ; TRIGGERS THE FREE TEXT VALUE OF FIELD .312 TO NULL (deletes it)
20 Q:'$G(DFN)
21 N DGROOT,X,Y
22 S DGROOT(2,DFN_",",.312)="@"
23 D FILE^DIE(,"DGROOT")
24 Q
25 ;
26CFLTF(DGI) ;CLAIM FOLDER LOCATION screen of INSTITUTIONS with specific types
27 ; DGI = facility (pointer to file 4)
28 ; Returns 1 if valid facility type for facility ien DGI
29 ; Returns 0 if invalid facility type for facility ien DGI
30 N DGARR,DGX,OK,X,Y,Z
31 S OK=0
32 I $G(DGI)="" G CFLTFQ
33 F Z="RO","RO&IC","RO-OC","RPC","M&ROC","M&ROC(M&RO)" S DGARR(Z)=""
34 D F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")
35 I $G(DGX("TYPE"))'="",$D(DGARR(DGX("TYPE"))) S OK=1
36CFLTFQ Q OK
37 ;
38PFTF(DGI) ;PREFERRED FACILITY screens of INSTITUTIONS for valid facility types
39 ; DGI = facility (pointer to file 4)
40 ; Returns 1 if valid facility type for facility
41 ; Returns 0 if invalid facility type for facility
42 N DGARR,OK,X,Y,Z
43 S OK=0
44 I $G(DGI)="" G PFTFQ
45 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)=""
46 D F4^XUAF4($$STA^XUAF4(+DGI),.DGX,"A")
47 I $G(DGX("TYPE"))'="",$D(DGARR(DGX("TYPE"))) S OK=1
48PFTFQ Q OK
49 ;
Note: See TracBrowser for help on using the repository browser.