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 ;;