source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHHI9.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PRCHHI9 ;WISC/TGH-IFCAP SEGMENTS DE (CO) ;4/10/92 2:59 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4CO(A2,A3,VAR1,ITEM,NUM) ; Note:
5 ; Comments and Descriptions are at two different levels
6 ;
7 ; A2 = File node level eg A2=2 ! A2=4 ect
8 ; A3 = File node 'type' eg "CO" ! "DE"
9 ; VAR1 = Record Number (Ex. VAR1=99999550)
10 ; ITEM = Item number or "" if doing comments
11 ; LEVEL = Subscript 'level' for storage in 423
12 ;
13 N CNT,CO,COM,DES,DESC,DDIWF,DIWL,DIWR,II,J,N,X,SUB
14 S (CO,DES)=0,II=""
15 S DIWR=60,DIWL=1,DIWF="" K ^UTILITY($J,"W")
16 G:A3'="CO" DISC
17 ;
18COM ; Comments - '4' in 442
19 S LEVEL=60,SUB="423.21A"
20 S COM=$G(^PRC(442,VAR1,A2,0)) G:COM="" QUIT G:$P(COM,U,4)'>0 QUIT
21 F S CO=$O(^PRC(442,VAR1,A2,CO)) Q:CO'>0 S X=$G(^(CO,0)) D DIWP^PRCUTL($G(DA))
22 G SET
23DISC ; Item Descriptions - '2' in 442
24 S LEVEL=22,SUB="423.0531A"
25 S DESC=$G(^PRC(442,VAR1,A2,ITEM,1,0)) G:DESC="" QUIT
26 G:$P(DESC,U,4)'>0 QUIT
27 F S DES=$O(^PRC(442,VAR1,A2,ITEM,1,DES)) Q:DES'>0 S X=$G(^(DES,0)) D DIWP^PRCUTL($G(DA))
28SET S J=$G(^UTILITY($J,"W",1)) G:J'>0 QUIT
29 S CNT=0 ;;$G(^PRCF(423,PRCFA("CSDA"),22,0)),CNT=$P(CNT,U,3)
30 ;
31 ;NOTE -- Need to verify CNT+II level does not already exist!!
32 F II=1:1:J S N=$G(^UTILITY($J,"W",1,II,0)) D
33 .;S ^PRCF(423,PRCFA("CSDA"),LEVEL,(CNT+II),0)=(CNT+II)_"^|"_A3_"^^"_N
34 .;
35 .S NUM=NUM+1,^TMP($J,"STRING",NUM)=A3_"^"_N_"^|"
36 .Q
37QUIT ;Set 'Top' level
38 ;I $G(J)>0 S ^PRCF(423,PRCFA("CSDA"),LEVEL,0)="^"_SUB_"^"_(CNT+J)_"^"_(CNT+J)
39 Q
Note: See TracBrowser for help on using the repository browser.