Return to DIARR6.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIARR6	;SFISC/DCM-PROCESS ARCHIVED FILE WITH INDEX ;11/18/92  11:49 AM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	S DIARFILE=$P(DIARL,U,3),DIARFN=+$P(DIARL,U,2)
    5: 	S DIARREC=$P(DIARL,U,4,99)
    6: 	F DIARXX=1:1 S DIARFLD=$P(DIARREC,U,DIARXX) Q:DIARFLD=""  S DIARFNO=$P(DIARFLD,":"),DIARFNA=$P(DIARFLD,":",2) D
    7: 	. I +DIARFNO=.01 S DIAR01=DIARFNA
    8: 	. S DIARPC(DIARXX)=DIARFNO_U_DIARFNA
    9: 	. S:+DIARFNO'=.01 DIARID(DIARFNO)=DIARFNA_U_DIARFNO
   10: 	. S DIARCNT=DIARXX
   11: 	. Q
   12: 	S DIARCTR=0,DIARFLGT=0
   13: 	F  X DIARX Q:DIARL["$DAT"  S DIARCTR=DIARCTR+1 F DIARXX=1:1:DIARCNT S DIARFLD=$P(DIARL,U,DIARXX) S DIARFNA=$P(DIARPC(DIARXX),U,2),DIARFNO=+DIARPC(DIARXX),^TMP("DIARHLP",$J,DIARCTR,DIARFNO)=DIARFNA_" = "_DIARFLD D FLGTH
   14: 	Q
   15: 	;
   16: FLGTH	S $P(DIARPC(DIARXX),U,3)=$S($L(DIARFLD)>+$P(DIARPC(DIARXX),U,3):$L(DIARFLD),1:+$P(DIARPC(DIARXX),U,3))
   17: 	Q
   18: 	;
   19: PROC	S DIARIXCT=0 K DIARRF
   20: PROC1	F  X DIARX Q:DIARL["$DAT"  G PROC1:DIARL["$INDEX" D PROC2 D MATCH^DIARR2 K:'$G(DIARIXX(DIARIXCT)) DIARIXX(DIARIXCT) G PROC1
   21: 	Q:'$D(DIARIXX)
   22: 	S (DIARIXCT,DIARXX)=1 D:$G(DIARIXX(DIARIXCT)) FOUND
   23: 	F  S DIARXX=$O(DIARIXX(DIARXX)) Q:DIARXX'>0  D PROC1A
   24: 	Q
   25: 	;
   26: PROC1A	F  X DIARX Q:DIARL["#$#"  I DIARL["$DAT" S DIARIXCT=DIARIXCT+1 I DIARIXCT=DIARXX D FOUND Q
   27: 	Q
   28: 	;
   29: PROC2	K DIARA S DIARIXCT=DIARIXCT+1,DIARIXX(DIARIXCT)=""
   30: 	F DIARXX=1:1:DIARCNT S DIARVAL=$P(DIARL,U,DIARXX) D PROC2A
   31: 	Q
   32: 	;
   33: PROC2A	I +$P(DIARPC(DIARXX),U)=.01 S DIARA(.01)=DIARVAL Q
   34: 	S DIARA("ID",+$P(DIARPC(DIARXX),U))=DIARVAL
   35: 	Q
   36: 	;
   37: FOUND	K ^TMP("DIARFG",$J) S DIARZ=1 D SET
   38: 	F DIARZ=DIARZ+1:1 X DIARX D SET I DIARL["$END DAT" Q
   39: 	F DIARZ=1:1 S DIARY=$P(DIARIXX(DIARIXCT),",",DIARZ) Q:DIARY=""  S DIARRF(DIARY)=$S($D(DIARRF(DIARY)):DIARRF(DIARY)+1,1:0) D SETFG
   40: 	Q
   41: 	;
   42: SET	S ^TMP("DIARFG",$J,DIARZ)=DIARL
   43: 	Q
   44: 	;
   45: SETFG	S %X="^TMP(""DIARFG"",$J,",%Y="^TMP(""DIAR"",$J,DIARY,DIARRF(DIARY)," D %XY^%RCR
   46: 	Q