source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCWS.m@ 1240

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

initial load of WorldVistAEHR
File size: 2.9 KB
Line 
1FSCRPCWS ;SLC/STAFF-NOIS RPC Web Save ;7/23/98 21:48
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4NEWWEB(IN,OUT) ; from FSCRPX (RPCNewWeb)
5 N CNT,ID,LINE,NEWPACK,NUM,PACKAGE,TITLE
6 K FIELDS,^TMP("FSC WP",$J)
7 S PACKAGE=+^TMP("FSCRPC",$J,"INPUT",1)
8 I $O(^FSCD("WEB","C",PACKAGE,0)) S NEWPACK=0
9 E S NEWPACK=1
10 S TITLE=^TMP("FSCRPC",$J,"INPUT",2)
11 S NOW=$$NOW^XLFDT()
12 L +^FSCD("WEB",0):20 I '$T Q
13 S ID=1+$P(^FSCD("WEB",0),U,3)
14 F Q:'$D(^FSCD("WEB",ID,0)) S ID=ID+1
15 S $P(^FSCD("WEB",0),U,3)=ID,$P(^(0),U,4)=$P(^(0),U,4)+1
16 S ^FSCD("WEB",ID,0)="P"_ID_U_PACKAGE_U_DUZ_U_NOW_U_DUZ_U_NOW
17 L -^FSCD("WEB",0)
18 S ^FSCD("WEB",ID,1)=TITLE
19 D PROCESS^FSCRPCNC(.FIELDS)
20 I $O(^TMP("FSC WP",$J,"DESC",0)) D
21 .K ^FSCD("WEB",ID,2)
22 .S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"DESC",NUM)) Q:NUM<1 S LINE=^(NUM) D
23 ..S CNT=CNT+1
24 ..S ^FSCD("WEB",ID,2,CNT,0)=LINE
25 .S ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
26 I $O(^TMP("FSC WP",$J,"RES",0)) D
27 .K ^FSCD("WEB",ID,3)
28 .S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"RES",NUM)) Q:NUM<1 S LINE=^(NUM) D
29 ..S CNT=CNT+1
30 ..S ^FSCD("WEB",ID,3,CNT,0)=LINE
31 .S ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
32 S DIK="^FSCD(""WEB"",",DA=ID
33 D IX1^DIK
34 K FIELDS,^TMP("FSC WP",$J)
35 S CNT=0
36 I NEWPACK D MAIN^FSCRPCW1(.CNT)
37 D PACK^FSCRPCW2(PACKAGE,.CNT)
38 D SOL^FSCRPCW3(ID,.CNT)
39 Q
40 ;
41EDITWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
42 N CNT,ID,LINE,NEWPACK,NUM,OLDPACK,PACKAGE,TITLE
43 K FIELDS,^TMP("FSC WP",$J)
44 S PACKAGE=+^TMP("FSCRPC",$J,"INPUT",1),ID=+$P(^(1),U,2)
45 I '$D(^FSCD("WEB",ID,0)) Q
46 S OLDPACK=+$P(^FSCD("WEB",ID,0),U,2)
47 I $O(^FSCD("WEB","C",PACKAGE,0)) S NEWPACK=0
48 E S NEWPACK=1
49 I OLDPACK'=PACKAGE S NEWPACK=1
50 S TITLE=^TMP("FSCRPC",$J,"INPUT",2)
51 S NOW=$$NOW^XLFDT()
52 N DA,DIE,DR,X,Y
53 S DA=ID,DIE="^FSCD(""WEB"","
54 S DR="1///"_PACKAGE_";4///"_DUZ_";5///"_NOW
55 L +^FSCD("WEB",0):20 I '$T Q
56 D ^DIE
57 L -^FSCD("WEB",0)
58 S ^FSCD("WEB",ID,1)=TITLE
59 D PROCESS^FSCRPCNC(.FIELDS)
60 K ^FSCD("WEB",ID,2)
61 I $O(^TMP("FSC WP",$J,"DESC",0)) D
62 .S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"DESC",NUM)) Q:NUM<1 S LINE=^(NUM) D
63 ..S CNT=CNT+1
64 ..S ^FSCD("WEB",ID,2,CNT,0)=LINE
65 .S ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
66 K ^FSCD("WEB",ID,3)
67 I $O(^TMP("FSC WP",$J,"RES",0)) D
68 .S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"RES",NUM)) Q:NUM<1 S LINE=^(NUM) D
69 ..S CNT=CNT+1
70 ..S ^FSCD("WEB",ID,3,CNT,0)=LINE
71 .S ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
72 S DIK="^FSCD(""WEB"",",DA=ID
73 D IX1^DIK
74 K FIELDS,^TMP("FSC WP",$J)
75 S CNT=0
76 I NEWPACK D MAIN^FSCRPCW1(.CNT)
77 I OLDPACK'=PACKAGE D PACK^FSCRPCW2(OLDPACK,.CNT)
78 D PACK^FSCRPCW2(PACKAGE,.CNT)
79 D SOL^FSCRPCW3(ID,.CNT)
80 Q
81 ;
82DELWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
83 N CALL,CNT,ID,PACK,URL
84 S ID=+^TMP("FSCRPC",$J,"INPUT",1)
85 I '$D(^FSCD("WEB",ID,0)) Q
86 S PACK=+$P(^FSCD("WEB",ID,0),U,2)
87 D DEL^FSCUCD("^FSCD(""WEB"",",ID)
88 S CNT=0
89 I '$O(^FSCD("WEB","C",PACK,0)) D MAIN^FSCRPCW1(.CNT)
90 D PACK^FSCRPCW2(PACK,.CNT)
91 S URL=$P($G(^FSC("PARAM",1,1.8)),U,2)_"p"_ID_".htm"
92 S CALL=0 F S CALL=$O(^FSCD("CALL","AWEB",URL,CALL)) Q:CALL<1 D
93 .D WEB^FSCRPCEB(CALL,"")
94 Q
Note: See TracBrowser for help on using the repository browser.