source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXQ09.m@ 1671

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1GMTSXQ09 ; SLC/JER - XQORM3 for Export w/Health Summary ;1/10/92 15:05
2 ;;2.5;Health Summary;;Dec 16, 1992
3XQORM3 ; SLC/KCM - Lookup (cont.) ;10/19/90 14:30 ;
4 ;;6.52;Copyright 1990, DVA;
5LOOK ;From: XQORM2
6 K ORUFD,ORUDA S ORUFD=0,ORUW=X
7 I $D(^XUTL("XQORM",XQORM,"B",X)) S ORUDA=0 F I=0:0 S ORUDA=$O(^XUTL("XQORM",XQORM,"B",X,ORUDA)) Q:ORUDA="" I '$D(ORUDA(ORUDA)) D LOOK1 Q:ORUER
8 S X=$E(X,1,$L(X)-1)_$C($A($E(X,$L(X)))-1)_"~"
9 F I=0:0 S X=$O(^XUTL("XQORM",XQORM,"B",X)) Q:X=""!($E(X,1,$L(ORUW))'=ORUW)!(XQORM(0)["X"&(X'=ORUW)) S ORUDA=0 F I=0:0 S ORUDA=$O(^XUTL("XQORM",XQORM,"B",X,ORUDA)) Q:ORUDA="" I '$D(ORUDA(ORUDA)) D LOOK1
10 S ORUDA=0 Q:ORUER I ORUFD=1 S ORUDA=ORUFD(1) Q
11 I 'ORUFD,ORUX(ORUT)'="ALL",XQORM(0)["A" S ORUER=1 D NF^XQORM4 I (ORUX[",")!(ORUX["-") S ORUER=0 D PICK
12 D:ORUFD>1 PICK ;S:'ORUFD ORUER=1
13 Q
14LOOK1 S ORUFD=ORUFD+1,ORUFD(ORUFD)=ORUDA,ORUDA(ORUDA)=""
15 Q
16PICK I XQORM(0)'["A" S ORUFD=0 Q
17 I ORUFD F J=1:1:ORUFD W:$D(^XUTL("XQORM",XQORM,ORUFD(J),0)) !,$J(J,6),?9,$P(^(0),"^",3)
18 F I=0:0 D PICK1 I $L(X)'>80,X?.ANP S:'$T!('$L(X)) X="^" S:X="^^" DIROUT=1 S:X="^^" ORUER=1 Q:X'["?" D HELP3^XQORM5
19 S ORUFD=0 Q:ORUER
20 I $D(ORUFD(X)) S ORUDA=ORUFD(X),ORUFD=1 Q
21 D:$L(X)&(X'["^") LOOK
22 Q
23PICK1 W !,$S(ORUX[","!(ORUX["-"):"For entry """_ORUW_""" ",1:""),$S(ORUFD:"CHOOSE 1-"_ORUFD_": ",1:"re-enter: ")
24 R X:$S($D(DTIME):DTIME,1:"") D:X'?.ANP CC^XQORM4 D:$L(X)>80 LL^XQORM4
25 Q
26UPD ;from XQORM2
27 S X="",ORUSQ=ORUSQ+1 S:$D(^XUTL("XQORM",XQORM,ORUDA,0)) X=^(0) I '$L(X) S ORUER=1 Q
28 I $D(ORUX(ORUT,"'")) S X=$O(Y("B",ORUDA,"")) K:$L(X) Y(X),Y("B",ORUDA,X) S:$L(X) Y=Y-1 Q
29 S Y=Y+1,Y(ORUSQ)=$P(X,"^",1,3),Y("B",ORUDA,ORUSQ)="",$P(Y(ORUSQ),"^",4)=ORUX(ORUT) S:$D(ORUX(ORUT,"=")) Y(ORUSQ)=Y(ORUSQ)_"="_ORUX(ORUT,"=")
30 Q
31RNG ;From: XQORM2
32 Q:X'?1.N1"-"1.N
33 I $P(X,"-",1)'<$P(X,"-",2) D:XQORM(0)["A" IR^XQORM4 S ORUER=1 Q
34 S ORUB="" F K=$P(X,"-",1):1:$P(X,"-",2) S ORUB=ORUB_K_"," I $L(ORUB)>225 D:XQORM(0)["A" LR^XQORM4 S ORUER=1 Q
35 S X=ORUB
36 Q
Note: See TracBrowser for help on using the repository browser.