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

RMIMU1 ;WPB/JLTP ; FUNCTIONAL INDEPENDENCE UTILITIES CONT'D ; 30-AUG-2002
 ;;1.0;FUNCTIONAL INDEPENDENCE;;Apr 15, 2003
OF(IFN,VAL) ; File Other Fields
 N DA,DIE,DR,EDIT,FLD,I,II,LINE,LOC,X,Y
 S DR="" F LINE=1:1 S TEXT=$P($T(FLDS+LINE),";;",2) Q:TEXT=""  D
 .S FLD=$P(TEXT,U),LOC=$P(TEXT,U,2),SS=$P(LOC,","),LOC=$P(LOC,",",2)
 .I $P($G(VAL(SS)),U,LOC)="" Q
 .S EDIT=FLD_"///"_$P(VAL(SS),U,LOC)
 .I ($L(DR)+$L(EDIT))>200 D
 ..S DA=IFN,DIE="^RMIM(783," D ^DIE S DR=""
 .S:DR]"" DR=DR_";" S DR=DR_EDIT
 I DR]"" S DA=IFN,DIE="^RMIM(783," D ^DIE
 K ^RMIM(783,IFN,100) S I=9,II=0
 F  S I=$O(VAL(I)) Q:'I  S II=II+1,^RMIM(783,IFN,100,II,0)=VAL(I)
 S ^RMIM(783,IFN,100,0)="^783.01^"_II_U_II
 Q 1
GF(RMIMR) ; Retrieve Other Fields
 N FLD,GN,GP,LINE,N,P,X
 S IFN=+RMIMR(1)
 F LINE=1:1 S TEXT=$P($T(FLDS+LINE),";;",2) Q:TEXT=""  D
 .S FLD=$P(TEXT,U),P=$P(TEXT,U,2),N=$P(P,","),P=$P(P,",",2)
 .I +FLD=.16 S $P(RMIMR(N),U,12)=$P(^RMIM(783,IFN,0),U,16) Q
 .I +FLD=.17 S $P(RMIMR(N),U,13)=$P(^RMIM(783,IFN,0),U,17) Q
 .I FLD'=+FLD S $P(RMIMR(N),U,P)=$$GET1^DIQ(783,IFN,+FLD) Q
 .S X=$P(^DD(783,+FLD,0),U,4),GN=$P(X,";"),GP=$P(X,";",2)
 .S X=$P($G(^RMIM(783,IFN,GN)),U,GP)
 .I X S $P(RMIMR(N),U,P)=$$FMTE^XLFDT(X,5)
 S I=0,II=$O(RMIMR(""),-1)
 F  S I=$O(^RMIM(783,IFN,100,I)) Q:'I  S II=II+1,RMIMR(II)=^(I,0)
 Q
FLDS ;
 ;;.11^1,11
 ;;.16/^1,12
 ;;.17/^1,13
 ;;1.01/^2,1
 ;;1.02/^2,2
 ;;1.03/^2,3
 ;;1.04/^2,4
 ;;1.05/^2,5
 ;;1.06/^2,6
 ;;1.07/^2,7
 ;;1.08/^2,8
 ;;1.09/^2,9
 ;;2.01/^3,1
 ;;2.03/^3,3
 ;;2.04^3,4
 ;;2.05^3,5
 ;;2.06^3,6
 ;;2.07^3,7
 ;;2.08^3,8
 ;;2.09^3,9
 ;;2.1/^3,10
 ;;2.11/^3,11
 ;;3.01/^4,1
 ;;3.02/^4,2
 ;;3.03/^4,3
 ;;3.04/^4,4
 ;;3.05/^4,5
 ;;3.06/^4,6
 ;;3.07/^4,7
 ;;4.01/^5,1
 ;;4.02/^5,2
 ;;4.03/^5,3
 ;;4.04/^5,4
 ;;4.05/^5,5
 ;;4.06/^5,6
 ;;4.07/^5,7
 ;;4.08/^5,8
 ;;4.09/^5,9
 ;;4.1/^5,10
 ;;4.11/^5,11
 ;;4.12/^5,12
 ;;4.13/^5,13
 ;;4.14/^5,14
 ;;4.15/^5,15
 ;;4.16/^5,16
 ;;4.17/^5,17
 ;;4.18/^5,18
 ;;4.19/^5,19
 ;;4.2/^5,20
 ;;4.21/^5,21
 ;;5.01/^6,1
 ;;5.02/^6,2
 ;;5.03/^6,3
 ;;5.04/^6,4
 ;;5.05/^6,5
 ;;5.06/^6,6
 ;;5.07/^6,7
 ;;5.08/^6,8
 ;;5.09/^6,9
 ;;5.1/^6,10
 ;;5.11/^6,11
 ;;5.12/^6,12
 ;;5.13/^6,13
 ;;5.14/^6,14
 ;;5.15/^6,15
 ;;5.16/^6,16
 ;;5.17/^6,17
 ;;5.18/^6,18
 ;;5.19/^6,19
 ;;5.2/^6,20
 ;;5.21/^6,21
 ;;6.01/^7,1
 ;;6.02/^7,2
 ;;6.03/^7,3
 ;;6.04/^7,4
 ;;6.05/^7,5
 ;;6.06/^7,6
 ;;6.07/^7,7
 ;;6.08/^7,8
 ;;6.09/^7,9
 ;;6.1/^7,10
 ;;6.11/^7,11
 ;;6.12/^7,12
 ;;6.13/^7,13
 ;;6.14/^7,14
 ;;6.15/^7,15
 ;;6.16/^7,16
 ;;6.17/^7,17
 ;;6.18/^7,18
 ;;6.19/^7,19
 ;;6.2/^7,20
 ;;6.21/^7,21
 ;;7.01/^8,1
 ;;7.02/^8,2
 ;;7.03/^8,3
 ;;7.04/^8,4
 ;;7.05/^8,5
 ;;7.06/^8,6
 ;;7.07/^8,7
 ;;7.08/^8,8
 ;;7.09/^8,9
 ;;7.1/^8,10
 ;;7.11/^8,11
 ;;7.12/^8,12
 ;;7.13/^8,13
 ;;7.14/^8,14
 ;;7.15/^8,15
 ;;7.16/^8,16
 ;;7.17/^8,17
 ;;7.18/^8,18
 ;;7.19/^8,19
 ;;7.2/^8,20
 ;;7.21/^8,21
 ;;8.01/^9,1
 ;;8.02/^9,2
 ;;8.03/^9,3
 ;;8.04/^9,4
 ;;8.05/^9,5
 ;;8.06/^9,6
 ;;8.07/^9,7
 ;;8.08/^9,8
 ;;8.09/^9,9
 ;;8.1/^9,10
 ;;8.11/^9,11
 ;;8.12/^9,12
 ;;8.13/^9,13
 ;;8.14/^9,14
 ;;8.15/^9,15
 ;;8.16/^9,16
 ;;8.17/^9,17
 ;;8.18/^9,18
 ;;8.19/^9,19
 ;;8.2/^9,20
 ;;8.21/^9,21
 ;;