FSCRPCWS ;SLC/STAFF-NOIS RPC Web Save ;7/23/98 21:48
;;1.1;NOIS;;Sep 06, 1998
;
NEWWEB(IN,OUT) ; from FSCRPX (RPCNewWeb)
N CNT,ID,LINE,NEWPACK,NUM,PACKAGE,TITLE
K FIELDS,^TMP("FSC WP",$J)
S PACKAGE=+^TMP("FSCRPC",$J,"INPUT",1)
I $O(^FSCD("WEB","C",PACKAGE,0)) S NEWPACK=0
E S NEWPACK=1
S TITLE=^TMP("FSCRPC",$J,"INPUT",2)
S NOW=$$NOW^XLFDT()
L +^FSCD("WEB",0):20 I '$T Q
S ID=1+$P(^FSCD("WEB",0),U,3)
F Q:'$D(^FSCD("WEB",ID,0)) S ID=ID+1
S $P(^FSCD("WEB",0),U,3)=ID,$P(^(0),U,4)=$P(^(0),U,4)+1
S ^FSCD("WEB",ID,0)="P"_ID_U_PACKAGE_U_DUZ_U_NOW_U_DUZ_U_NOW
L -^FSCD("WEB",0)
S ^FSCD("WEB",ID,1)=TITLE
D PROCESS^FSCRPCNC(.FIELDS)
I $O(^TMP("FSC WP",$J,"DESC",0)) D
.K ^FSCD("WEB",ID,2)
.S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"DESC",NUM)) Q:NUM<1 S LINE=^(NUM) D
..S CNT=CNT+1
..S ^FSCD("WEB",ID,2,CNT,0)=LINE
.S ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
I $O(^TMP("FSC WP",$J,"RES",0)) D
.K ^FSCD("WEB",ID,3)
.S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"RES",NUM)) Q:NUM<1 S LINE=^(NUM) D
..S CNT=CNT+1
..S ^FSCD("WEB",ID,3,CNT,0)=LINE
.S ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
S DIK="^FSCD(""WEB"",",DA=ID
D IX1^DIK
K FIELDS,^TMP("FSC WP",$J)
S CNT=0
I NEWPACK D MAIN^FSCRPCW1(.CNT)
D PACK^FSCRPCW2(PACKAGE,.CNT)
D SOL^FSCRPCW3(ID,.CNT)
Q
;
EDITWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
N CNT,ID,LINE,NEWPACK,NUM,OLDPACK,PACKAGE,TITLE
K FIELDS,^TMP("FSC WP",$J)
S PACKAGE=+^TMP("FSCRPC",$J,"INPUT",1),ID=+$P(^(1),U,2)
I '$D(^FSCD("WEB",ID,0)) Q
S OLDPACK=+$P(^FSCD("WEB",ID,0),U,2)
I $O(^FSCD("WEB","C",PACKAGE,0)) S NEWPACK=0
E S NEWPACK=1
I OLDPACK'=PACKAGE S NEWPACK=1
S TITLE=^TMP("FSCRPC",$J,"INPUT",2)
S NOW=$$NOW^XLFDT()
N DA,DIE,DR,X,Y
S DA=ID,DIE="^FSCD(""WEB"","
S DR="1///"_PACKAGE_";4///"_DUZ_";5///"_NOW
L +^FSCD("WEB",0):20 I '$T Q
D ^DIE
L -^FSCD("WEB",0)
S ^FSCD("WEB",ID,1)=TITLE
D PROCESS^FSCRPCNC(.FIELDS)
K ^FSCD("WEB",ID,2)
I $O(^TMP("FSC WP",$J,"DESC",0)) D
.S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"DESC",NUM)) Q:NUM<1 S LINE=^(NUM) D
..S CNT=CNT+1
..S ^FSCD("WEB",ID,2,CNT,0)=LINE
.S ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
K ^FSCD("WEB",ID,3)
I $O(^TMP("FSC WP",$J,"RES",0)) D
.S (CNT,NUM)=0 F S NUM=$O(^TMP("FSC WP",$J,"RES",NUM)) Q:NUM<1 S LINE=^(NUM) D
..S CNT=CNT+1
..S ^FSCD("WEB",ID,3,CNT,0)=LINE
.S ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
S DIK="^FSCD(""WEB"",",DA=ID
D IX1^DIK
K FIELDS,^TMP("FSC WP",$J)
S CNT=0
I NEWPACK D MAIN^FSCRPCW1(.CNT)
I OLDPACK'=PACKAGE D PACK^FSCRPCW2(OLDPACK,.CNT)
D PACK^FSCRPCW2(PACKAGE,.CNT)
D SOL^FSCRPCW3(ID,.CNT)
Q
;
DELWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
N CALL,CNT,ID,PACK,URL
S ID=+^TMP("FSCRPC",$J,"INPUT",1)
I '$D(^FSCD("WEB",ID,0)) Q
S PACK=+$P(^FSCD("WEB",ID,0),U,2)
D DEL^FSCUCD("^FSCD(""WEB"",",ID)
S CNT=0
I '$O(^FSCD("WEB","C",PACK,0)) D MAIN^FSCRPCW1(.CNT)
D PACK^FSCRPCW2(PACK,.CNT)
S URL=$P($G(^FSC("PARAM",1,1.8)),U,2)_"p"_ID_".htm"
S CALL=0 F S CALL=$O(^FSCD("CALL","AWEB",URL,CALL)) Q:CALL<1 D
.D WEB^FSCRPCEB(CALL,"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCWS 3114 printed Apr 09, 2024@21:23:10 Page 2
FSCRPCWS ;SLC/STAFF-NOIS RPC Web Save ;7/23/98 21:48
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
NEWWEB(IN,OUT) ; from FSCRPX (RPCNewWeb)
+1 NEW CNT,ID,LINE,NEWPACK,NUM,PACKAGE,TITLE
+2 KILL FIELDS,^TMP("FSC WP",$JOB)
+3 SET PACKAGE=+^TMP("FSCRPC",$JOB,"INPUT",1)
+4 IF $ORDER(^FSCD("WEB","C",PACKAGE,0))
SET NEWPACK=0
+5 IF '$TEST
SET NEWPACK=1
+6 SET TITLE=^TMP("FSCRPC",$JOB,"INPUT",2)
+7 SET NOW=$$NOW^XLFDT()
+8 LOCK +^FSCD("WEB",0):20
IF '$TEST
QUIT
+9 SET ID=1+$PIECE(^FSCD("WEB",0),U,3)
+10 FOR
if '$DATA(^FSCD("WEB",ID,0))
QUIT
SET ID=ID+1
+11 SET $PIECE(^FSCD("WEB",0),U,3)=ID
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+12 SET ^FSCD("WEB",ID,0)="P"_ID_U_PACKAGE_U_DUZ_U_NOW_U_DUZ_U_NOW
+13 LOCK -^FSCD("WEB",0)
+14 SET ^FSCD("WEB",ID,1)=TITLE
+15 DO PROCESS^FSCRPCNC(.FIELDS)
+16 IF $ORDER(^TMP("FSC WP",$JOB,"DESC",0))
Begin DoDot:1
+17 KILL ^FSCD("WEB",ID,2)
+18 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^TMP("FSC WP",$JOB,"DESC",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:2
+19 SET CNT=CNT+1
+20 SET ^FSCD("WEB",ID,2,CNT,0)=LINE
End DoDot:2
+21 SET ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
End DoDot:1
+22 IF $ORDER(^TMP("FSC WP",$JOB,"RES",0))
Begin DoDot:1
+23 KILL ^FSCD("WEB",ID,3)
+24 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^TMP("FSC WP",$JOB,"RES",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:2
+25 SET CNT=CNT+1
+26 SET ^FSCD("WEB",ID,3,CNT,0)=LINE
End DoDot:2
+27 SET ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
End DoDot:1
+28 SET DIK="^FSCD(""WEB"","
SET DA=ID
+29 DO IX1^DIK
+30 KILL FIELDS,^TMP("FSC WP",$JOB)
+31 SET CNT=0
+32 IF NEWPACK
DO MAIN^FSCRPCW1(.CNT)
+33 DO PACK^FSCRPCW2(PACKAGE,.CNT)
+34 DO SOL^FSCRPCW3(ID,.CNT)
+35 QUIT
+36 ;
EDITWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
+1 NEW CNT,ID,LINE,NEWPACK,NUM,OLDPACK,PACKAGE,TITLE
+2 KILL FIELDS,^TMP("FSC WP",$JOB)
+3 SET PACKAGE=+^TMP("FSCRPC",$JOB,"INPUT",1)
SET ID=+$PIECE(^(1),U,2)
+4 IF '$DATA(^FSCD("WEB",ID,0))
QUIT
+5 SET OLDPACK=+$PIECE(^FSCD("WEB",ID,0),U,2)
+6 IF $ORDER(^FSCD("WEB","C",PACKAGE,0))
SET NEWPACK=0
+7 IF '$TEST
SET NEWPACK=1
+8 IF OLDPACK'=PACKAGE
SET NEWPACK=1
+9 SET TITLE=^TMP("FSCRPC",$JOB,"INPUT",2)
+10 SET NOW=$$NOW^XLFDT()
+11 NEW DA,DIE,DR,X,Y
+12 SET DA=ID
SET DIE="^FSCD(""WEB"","
+13 SET DR="1///"_PACKAGE_";4///"_DUZ_";5///"_NOW
+14 LOCK +^FSCD("WEB",0):20
IF '$TEST
QUIT
+15 DO ^DIE
+16 LOCK -^FSCD("WEB",0)
+17 SET ^FSCD("WEB",ID,1)=TITLE
+18 DO PROCESS^FSCRPCNC(.FIELDS)
+19 KILL ^FSCD("WEB",ID,2)
+20 IF $ORDER(^TMP("FSC WP",$JOB,"DESC",0))
Begin DoDot:1
+21 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^TMP("FSC WP",$JOB,"DESC",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:2
+22 SET CNT=CNT+1
+23 SET ^FSCD("WEB",ID,2,CNT,0)=LINE
End DoDot:2
+24 SET ^FSCD("WEB",ID,2,0)="^^"_CNT_U_CNT_U_DT_U
End DoDot:1
+25 KILL ^FSCD("WEB",ID,3)
+26 IF $ORDER(^TMP("FSC WP",$JOB,"RES",0))
Begin DoDot:1
+27 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^TMP("FSC WP",$JOB,"RES",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:2
+28 SET CNT=CNT+1
+29 SET ^FSCD("WEB",ID,3,CNT,0)=LINE
End DoDot:2
+30 SET ^FSCD("WEB",ID,3,0)="^^"_CNT_U_CNT_U_DT_U
End DoDot:1
+31 SET DIK="^FSCD(""WEB"","
SET DA=ID
+32 DO IX1^DIK
+33 KILL FIELDS,^TMP("FSC WP",$JOB)
+34 SET CNT=0
+35 IF NEWPACK
DO MAIN^FSCRPCW1(.CNT)
+36 IF OLDPACK'=PACKAGE
DO PACK^FSCRPCW2(OLDPACK,.CNT)
+37 DO PACK^FSCRPCW2(PACKAGE,.CNT)
+38 DO SOL^FSCRPCW3(ID,.CNT)
+39 QUIT
+40 ;
DELWEB(IN,OUT) ; from FSCRPX (RPCEditWeb)
+1 NEW CALL,CNT,ID,PACK,URL
+2 SET ID=+^TMP("FSCRPC",$JOB,"INPUT",1)
+3 IF '$DATA(^FSCD("WEB",ID,0))
QUIT
+4 SET PACK=+$PIECE(^FSCD("WEB",ID,0),U,2)
+5 DO DEL^FSCUCD("^FSCD(""WEB"",",ID)
+6 SET CNT=0
+7 IF '$ORDER(^FSCD("WEB","C",PACK,0))
DO MAIN^FSCRPCW1(.CNT)
+8 DO PACK^FSCRPCW2(PACK,.CNT)
+9 SET URL=$PIECE($GET(^FSC("PARAM",1,1.8)),U,2)_"p"_ID_".htm"
+10 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","AWEB",URL,CALL))
if CALL<1
QUIT
Begin DoDot:1
+11 DO WEB^FSCRPCEB(CALL,"")
End DoDot:1
+12 QUIT
