source: FOIAVistA/tag/r/FUNCTIONAL_INDEPENDENCE-RMIM/RMIMU.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1RMIMU ;WPB/JLTP ; FUNCTIONAL INDEPENDENCE UTILITIES ; 14-AUG-2002
2 ;;1.0;FUNCTIONAL INDEPENDENCE;;Apr 15, 2003
3A(X) ; Add New Record to FIM Database
4 N AD,CASE,DA,DFN,DIE,DOB,DR,FAC,FACI,I,IFN,IG,OD,OK,OP,TYP
5 S CASE=+X,X=$P(X,U,2,9),OK=1 F I=1:1:7 I $P(X,U,I)="" S OK=0 Q
6 I 'OK Q $$ERR(-1)
7 S DFN=+X,SSN=$P(X,U,2),DOB=$P(X,U,3),FAC=$P(X,U,4),TYP=$P(X,U,5)
8 S IG=$P(X,U,6),OD=$P(X,U,7),AD=$P(X,U,8),OP="A"
9 S X=$$NFE(CASE),IFN=+X,CASE=$P(X,U,2) I X'>0 Q $$ERR(-2)
10 S X=IFN_U_CASE_U_DFN_U_SSN_U_DOB_U_FAC_U_TYP_U_IG_U_OD_U_AD
11 I '$$CF(X) Q $$ERR(-7)
12 Q IFN_U_CASE
13NFE(C) ; Create Record and Return IFN
14 N CASE,DA,DIC,DIE,DINUM,DR,IFN,X,Y
15 S CASE=+$G(C)
16 L +^RMIM(783,0) S X=$P(^RMIM(783,0),U,4)+1
17 F Q:'$D(^RMIM(783,X,0)) S X=X+1
18 L +^RMIM(783.9,1,0)
19 I 'CASE D
20 .S CASE=$P(^RMIM(783.9,1,0),U,2)+1
21 .F Q:'$D(^RMIM(783,"CASE",CASE)) S CASE=CASE+1
22 S DIC="^RMIM(783,",DIC(0)="L",DIC("DR")=".02////^S X=CASE",DINUM=X
23 D FILE^DICN S IFN=+Y
24 S $P(^RMIM(783.9,1,0),U,2)=CASE
25 L -^RMIM(783,0) L -^RMIM(783.9,1,0)
26 Q IFN_U_CASE
27E(X) ; Edit Existing Record
28 N CASE,CE,IFN,P,SENT,STATUS,X1
29 S CASE=+X,IFN=$O(^RMIM(783,"CASE",CASE,0)) Q:'IFN $$ERR(-6)
30 S X1=^RMIM(783,IFN,0),SENT=$P(X1,U,13)
31 F P=5,9:1:12 S:$P(X1,U,P) $P(X1,U,P)=$$FMTE^XLFDT($P(X1,U,P),5)
32 S CE=0 F P=2:1:9 I $P(X,U,P)'=$P(X1,U,P+1) S CE=1 Q
33 I 0,CE,SENT D Q STATUS
34 .S STATUS=$$D(X) Q:STATUS<1
35 .S STATUS=$$A(X)
36 S X=IFN_U_X
37 S STATUS=$$CF(X) I 'STATUS Q $$ERR(-7)
38 Q IFN_U_CASE
39D(X) ; Mark Record for Deletion
40 Q 1 ;Not Currently Used... Maybe Later
41 N CASE,DA,DIE,DR,IFN
42 S CASE=+X,IFN=$O(^RMIM(783,"CASE",CASE,0)) Q:'IFN $$ERR(-6)
43 S DA=IFN,DIE="^RMIM(783,",DR=".12////^S X=DT;.14////D" D ^DIE
44 Q IFN_U_CASE
45CF(VAL) ; File Critical Fields
46 N DA,DIE,DR,EDIT,FLD,LINE,PCE,VAAR,X,Y
47 S DR="" F LINE=1:1 S TEXT=$P($T(CRIT+LINE),";;",2) Q:TEXT="" D
48 .S FLD=$P(TEXT,U),PCE=$P(TEXT,U,2),VAR=$P(TEXT,U,3)
49 .I PCE S EDIT=FLD_"///"_$P(VAL,U,PCE)
50 .E I VAR]"" S EDIT=FLD_"///^S X="_VAR
51 .I ($L(DR)+$L(EDIT))>200 D
52 ..S DA=+VAL,DIE="^RMIM(783," D ^DIE S DR=""
53 .S:DR]"" DR=DR_";" S DR=DR_EDIT
54 I DR]"" S DA=+VAL,DIE="^RMIM(783," D ^DIE
55 Q 1
56GC(RMIMR) ; Retrieve Critical Fields for a Case
57 N FLD,GN,GP,LINE,N,P,X
58 S IFN=+RMIMR(1)
59 F LINE=1:1 S TEXT=$P($T(CRIT+LINE),";;",2) Q:TEXT="" D
60 .S FLD=$P(TEXT,U),P=$P(TEXT,U,2) Q:'P
61 .S X=$P(^DD(783,+FLD,0),U,4),GN=$P(X,";"),GP=$P(X,";",2)
62 .I FLD'=+FLD S $P(RMIMR(1),U,P)=$$GET1^DIQ(783,IFN,+FLD) Q
63 .S X=$P($G(^RMIM(783,IFN,GN)),U,GP)
64 .I X S $P(RMIMR(1),U,P)=$$FMTE^XLFDT(X,5)
65 Q
66ERR(E) ; Return Error Message
67 Q E_U_$P($T(ERMSG+$$ABS^XLFMTH(E)),";;",2)
68ERMSG ; Error Messages
69 ;;Missing Required Data
70 ;;New Record Could Not Be Created
71 ;;Invalid Facility Number
72 ;;No Data Received
73 ;;Invalid Operation Code
74 ;;Case # Not Found
75 ;;Error Filing Critical Fields
76 ;;Error Retrieving Patient Data
77 ;;
78CRIT ; Required Identifier Fields
79 ;;.03/^3
80 ;;.04/^4
81 ;;.05^5
82 ;;.06/^6
83 ;;.07/^7
84 ;;.08/^8
85 ;;.09^9
86 ;;.1^10
87 ;;.12/^^DT
88 ;;.14/^^OP
89 ;;.15/^^1
90 ;;
Note: See TracBrowser for help on using the repository browser.