source: FOIAVistA/trunk/r/LIST_MANAGER-VALM/VALMD.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1VALMD ;MJK/ALB - List Manager Demo Routine; APR 2, 1992 ;06/26/2006
2 ;;1.0;List Manager;**8**;Aug 13, 1993;Build 1
3 ;
4EN ; -- option entry point
5 K XQORS,VALMEVL
6 D EN^VALM("VALM DEMO APPLICATION")
7ENQ Q
8 ;
9 ;
10INIT ; -- build array
11 W ! S DIC("A")="Select Package: ",DIC="^DIC(9.4,",DIC(0)="AEMQ" D ^DIC K DIC
12 I Y<0 S VALMQUIT="" G INITQ
13PKG ; -- entry pt if package known
14 N VALMX,VALMCNTI,VALMPRO,VALMIFN,X,VALMPRE,Z
15 S VALMPKG=+Y
16 D CLEAN^VALM10
17 S (VALMCNTI,VALMCNT)=0,(VALMPRE,VALMPRO)=$P($G(^DIC(9.4,VALMPKG,0)),U,2)
18 F S VALMPRO=$O(^ORD(101,"B",VALMPRO)) Q:$E(VALMPRO,1,$L(VALMPRE))'=VALMPRE S VALMIFN=0 F S VALMIFN=$O(^ORD(101,"B",VALMPRO,VALMIFN)) Q:'VALMIFN I $D(^ORD(101,VALMIFN,0)) S VALMX=^(0) D
19 .S VALMCNTI=VALMCNTI+1 W:(VALMCNTI#10)=0 "."
20 .S X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
21 .S X=$$SETFLD^VALM1($P(VALMX,U),X,"NAME")
22 .S X=$$SETFLD^VALM1($P(VALMX,U,2),X,"TEXT") K Z S $E(Z,$L(X)+1,240)=""
23 .S VALMCNT=VALMCNT+1
24 .D SET^VALM10(VALMCNT,$E(X_Z,1,240),VALMCNTI) ; set text
25 .S ^TMP("VALMZIDX",$J,VALMCNTI)=VALMCNT_U_VALMIFN
26 .D:'(VALMCNT#9) FLDCTRL^VALM10(VALMCNT) ; defaults for all fields
27 .D FLDCTRL^VALM10(VALMCNT,"NUMBER") ; default for 1 field
28 .D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"NAME",IOUON,IOUOFF) ; adhoc
29 D NUL:'VALMCNT
30INITQ Q
31 ;
32HDR ; -- demo header
33 N VALMX
34 S VALMX=$G(^DIC(9.4,VALMPKG,0)),X=" Package: "_$P(VALMX,U)
35 S VALMHDR(1)=$$SETSTR^VALM1("Prefix: "_$P(VALMX,U,2),X,63,15)
36 S VALMHDR(2)="Description: "_$E($P(VALMX,U,3),1,65)
37 Q
38 ;
39NUL ; -- set nul message
40 I 'VALMCNT D
41 .F X=" "," No protocols to list." S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,X)
42 .S ^TMP("VALMZIDX",$J,1)=1,^(2)=2
43 Q
44 ;
45FNL ; -- clean up
46 K DIE,DIC,DR,DA,DE,DQ,VALMY,VALMPKG,^TMP("VALMZIDX",$J)
47 D CLEAN^VALM10
48 Q
49 ;
50EXP ; -- expand action
51 D FULL^VALM1
52 N VALMI,VALMAT,VALMY
53 D EN^VALM2(XQORNOD(0),"O") S VALMI=0
54 F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
55 .S VALMAT=$G(^TMP("VALMZIDX",$J,VALMI))
56 .W !!,@VALMAR@(+VALMAT,0),!
57 .S DA=+$P(VALMAT,U,2),DIC="^ORD(101,",DR="0" D EN^DIQ,PAUSE^VALM1
58 S VALMBCK="R",VALMSG="'Expand' was last action picked."
59 Q
60 ;
61EDIT ; -- edit action
62 N VALMA,VALMP,VALMI,VALMAT,VALMY
63 D MSG^VALM10("'Edit' action...")
64 D EN^VALM2(XQORNOD(0),"O") S VALMI=0 ; all the user to "O"ptionally answer
65 F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
66 .D SELECT^VALM10(VALMI,1) ; -- 'select' line
67 .S VALMAT=$G(^TMP("VALMZIDX",$J,VALMI))
68 .W !!,@VALMAR@(+VALMAT,0)
69 .S DA=+$P(VALMAT,U,2),VALMP=$G(^ORD(101,DA,0)),DIE=101,DR="1" D ^DIE K DIE,DR
70 .S VALMA=$G(^ORD(101,DA,0))
71 .I $P(VALMP,U,2)'=$P(VALMA,U,2) D UPD($P(VALMA,U,2),"TEXT",.VALMAT)
72 .D SELECT^VALM10(VALMI,0) ; -- 'de-select' line
73 D MSG^VALM10("")
74 S VALMBCK=$S(VALMCC:"",1:"R")
75 Q
76 ;
77DESC ; -- display description action
78 N VALMI,VALMY,VALMAT
79 D EN^VALM2(XQORNOD(0),"OS") S VALMI=0 ; select only a "S"ingle protocol
80 F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
81 .S VALMAT=+$P($G(^TMP("VALMZIDX",$J,VALMI)),U,2)
82 .I '$D(^ORD(101,VALMAT,1)) W !!,"No Description entered." D PAUSE^VALM1 Q
83 .D WP^VALM("^ORD(101,"_VALMAT_",1)",$P($G(^ORD(101,VALMAT,0)),U))
84 S VALMBCK="R"
85 Q
86 ;
87UPD(TEXT,FLD,VALMAT) ; -- update data for screen
88 D:VALMCC FLDCTRL^VALM10(+VALMAT,.FLD,.IOINHI,.IOINORM,1)
89 D FLDTEXT^VALM10(+VALMAT,.FLD,.TEXT)
90 Q
91 ;
92CHG ; -- change package action
93 K X I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)
94 I X="" R !!,"Select Package: ",X:DTIME
95 S DIC="^DIC(9.4,",DIC(0)="EMQ" D ^DIC K DIC G CHG:X["?"
96 I Y<0 D G CHGQ
97 .W !!,*7,"Package has not been changed."
98 .W ! S DIR(0)="E" D ^DIR K DIR
99 .S VALMBCK=""
100 D PKG,HDR S VALMBCK="R" S VALMBG=1
101CHGQ Q
Note: See TracBrowser for help on using the repository browser.