source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXQ06.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1GMTSXQ06 ; SLC/JER - XQORM for Export w/Health Summary ;1/10/92 15:01
2 ;;2.5;Health Summary;;Dec 16, 1992
3XQORM ; SLC/KCM - Menu Utility ; 5/2/89 14:52 ;
4 ;;6.52;Copyright 1990, DVA;
5 ;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
6EN K Y S Y=-1 Q:$D(XQORM)'=11 Q:XQORM'?1.N.1P.N1";".1"%"1.A1"(".ANP Q:'$D(@("^"_$P(XQORM,";",2)_+XQORM_",99)")) Q:$D(XQORM(0))["0"
7 I $D(^XUTL("XQORM",XQORM,0)),$P(^(0),"^",1)'=$P(@("^"_$P(XQORM,";",2)_+XQORM_",99)"),"^",1) D XREF
8 I '$D(^XUTL("XQORM",XQORM,0)) D XREF Q:Y<0
9 L ^XUTL("XQORM",XQORM,"XQORM PROTECT",$J):30 E W !,"Can't access menu at this time - try again later." S Y=-1 Q
10 S:$D(X)[0 X="" S ORUSV=X I $S('$D(IOM):1,'$D(IOF):1,'$D(IOST):1,'IOM:1,1:0) S IOP=$S($D(ORIO):ORIO,1:"HOME") D ^%ZIS S X=ORUSV
11 S (DX,DY)=0 X ^%ZOSF("XY") I $D(XQORM("H")),$L(XQORM("H")) X XQORM("H")
12 S X=ORUSV D:XQORM(0)["D" DISP^XQORM1 W !
13 F ORU=0:0 D:XQORM(0)["A" PRMT^XQORM1 S Y=-1 Q:'$L(X)!(X="^")!(X="^^") D EN^XQORM2 Q:Y'<0!(XQORM(0)'["A")
14 L K DX,DY,J,ORU,ORULT,ORUSV Q
15XREF N X S Y=-1 S:'$D(ORULT) ORULT=2
16 I $P(XQORM,";",2)="DIC(19," D X19 Q
17 S DIE="^"_$P(XQORM,";",2),DA=+XQORM,DR="99///"_$H
18 L (^XUTL("XQORM",XQORM),@(DIE_DA_")")):ORULT E S Y=-1 K DIE,DA Q
19 D ^DIE S Y=1 K DIC,DIE,DA,DR,D,D0,DI,DQ
20 L Q
21X19 L (^XUTL("XQORM",XQORM),^DIC(19,+XQORM)):ORULT E S Y=-1 Q
22 S DA=+XQORM D SET^XQORMX K DA S Y=1
23 L Q
Note: See TracBrowser for help on using the repository browser.