| 1 | DIARR6 ;SFISC/DCM-PROCESS ARCHIVED FILE WITH INDEX ;11/18/92 11:49 AM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
