FSCRPCPF ;SLC/STAFF-NOIS RPC Personal Fields ;5/18/98 15:42
;;1.1;NOIS;;Sep 06, 1998
;
SAVE(IN,OUT) ; from FSCRPX (RPCSavePersonalFields)
N CALL,CNT,DA,DIE,DIK,DR,LINE,LONG,NUM,NUMBER,OK,SHORT,X,Y
S CALL=$G(^TMP("FSCRPC",$J,"INPUT",1)),SHORT=$G(^(2)),NUMBER=$G(^(3)),LONG=$G(^(4))
S CALL=$P(CALL,"CALL^",2)
I 'CALL Q
S SHORT=$P(SHORT,"SHORT^",2)
S NUMBER=$P(NUMBER,"NUMBER^",2)
S LONG=$P(LONG,"LONG^",2)
S DA=+$G(^FSCD("CALL USER","AUC",DUZ,CALL))
I DA D
.I '$L(SHORT) S SHORT="@"
.I 'NUMBER S NUMBER="@"
.I '$L(LONG) S LONG="@"
.S DR="2///"_$$FIX^FSCRPCEC(SHORT)_";3///"_NUMBER_";4///"_$$FIX^FSCRPCEC(LONG)
.S DIE="^FSCD(""CALL USER"","
.D ^DIE
E D
.L +^FSCD("CALL USER",0):5 I '$T Q
.S DA=1+$P(^FSCD("CALL USER",0),U,3)
.F Q:'$D(^FSCD("CALL USER",DA,0)) S DA=DA+1
.S $P(^FSCD("CALL USER",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
.S ^FSCD("CALL USER",DA,0)=CALL_U_DUZ_U_SHORT_U_NUMBER
.I $L(LONG) S ^FSCD("CALL USER",DA,1)=LONG
.L -^FSCD("CALL USER",0)
.S DIK="^FSCD(""CALL USER"","
.D IX1^DIK
D MRE^FSCMR(DUZ,CALL)
I $G(^TMP("FSCRPC",$J,"INPUT",5))'="{NOTE}" Q
K ^FSCD("CALL USER",DA,2)
S CNT=0
S NUM=5 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) Q:LINE="{{{}}}" D
.S CNT=CNT+1
.S ^FSCD("CALL USER",DA,2,CNT,0)=LINE
I CNT S ^FSCD("CALL USER",DA,2,0)="^^"_CNT_U_CNT_U_DT_U
S OK=1 D
.Q:$L($P(^FSCD("CALL USER",DA,0),U,3)) Q:$L($P(^(0),U,4)) Q:$L($G(^(1))) Q:$O(^(2,0))
.S OK=0
I 'OK D DEL^FSCUCD("^FSCD(""CALL USER"",",DA)
Q
;
GET(IN,OUT) ; from FSCRPX (RPCGetPersonalFields)
N CALL,CNT,IEN,LINE,LONG,NUM,NUMBER,SHORT
S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
S IEN=+$G(^FSCD("CALL USER","AUC",DUZ,CALL))
I 'IEN Q
S ZERO=$G(^FSCD("CALL USER",IEN,0))
S SHORT=$P(ZERO,U,3)
S NUMBER=$P(ZERO,U,4)
S LONG=$G(^FSCD("CALL USER",IEN,1))
S ^TMP("FSCRPC",$J,"OUTPUT",1)="SHORT^"_SHORT
S ^TMP("FSCRPC",$J,"OUTPUT",2)="NUMBER^"_NUMBER
S ^TMP("FSCRPC",$J,"OUTPUT",3)="LONG^"_LONG
S CNT=3
S NUM=0 F S NUM=$O(^FSCD("CALL USER",IEN,2,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
Q
;
CALL(IN,OUT) ; from FSCRPX (RPCCallPersonal)
N CALL,CNT,IEN,LINE,LONG,NUM,NUMBER,SHORT
S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
S CALLID=$P($G(^FSCD("CALL",CALL,0)),U)
S IEN=+$G(^FSCD("CALL USER","AUC",DUZ,CALL))
I 'IEN D Q
.S ^TMP("FSCRPC",$J,"OUTPUT",1)="No information in personal fields for "_CALLID_"."
S ^TMP("FSCRPC",$J,"OUTPUT",1)="Personal Fields for "_CALLID_":"
S ZERO=$G(^FSCD("CALL USER",IEN,0))
S SHORT=$P(ZERO,U,3)
S NUMBER=$P(ZERO,U,4)
S LONG=$G(^FSCD("CALL USER",IEN,1))
S ^TMP("FSCRPC",$J,"OUTPUT",2)="Short Text: "_SHORT
S ^TMP("FSCRPC",$J,"OUTPUT",3)="Number: "_NUMBER
S ^TMP("FSCRPC",$J,"OUTPUT",4)="Long Text: "_LONG
S ^TMP("FSCRPC",$J,"OUTPUT",5)="Note:"
S CNT=5
S NUM=0 F S NUM=$O(^FSCD("CALL USER",IEN,2,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCPF 3015 printed Apr 09, 2024@21:22 Page 2
FSCRPCPF ;SLC/STAFF-NOIS RPC Personal Fields ;5/18/98 15:42
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
SAVE(IN,OUT) ; from FSCRPX (RPCSavePersonalFields)
+1 NEW CALL,CNT,DA,DIE,DIK,DR,LINE,LONG,NUM,NUMBER,OK,SHORT,X,Y
+2 SET CALL=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET SHORT=$GET(^(2))
SET NUMBER=$GET(^(3))
SET LONG=$GET(^(4))
+3 SET CALL=$PIECE(CALL,"CALL^",2)
+4 IF 'CALL
QUIT
+5 SET SHORT=$PIECE(SHORT,"SHORT^",2)
+6 SET NUMBER=$PIECE(NUMBER,"NUMBER^",2)
+7 SET LONG=$PIECE(LONG,"LONG^",2)
+8 SET DA=+$GET(^FSCD("CALL USER","AUC",DUZ,CALL))
+9 IF DA
Begin DoDot:1
+10 IF '$LENGTH(SHORT)
SET SHORT="@"
+11 IF 'NUMBER
SET NUMBER="@"
+12 IF '$LENGTH(LONG)
SET LONG="@"
+13 SET DR="2///"_$$FIX^FSCRPCEC(SHORT)_";3///"_NUMBER_";4///"_$$FIX^FSCRPCEC(LONG)
+14 SET DIE="^FSCD(""CALL USER"","
+15 DO ^DIE
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 LOCK +^FSCD("CALL USER",0):5
IF '$TEST
QUIT
+18 SET DA=1+$PIECE(^FSCD("CALL USER",0),U,3)
+19 FOR
if '$DATA(^FSCD("CALL USER",DA,0))
QUIT
SET DA=DA+1
+20 SET $PIECE(^FSCD("CALL USER",0),U,3)=DA
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+21 SET ^FSCD("CALL USER",DA,0)=CALL_U_DUZ_U_SHORT_U_NUMBER
+22 IF $LENGTH(LONG)
SET ^FSCD("CALL USER",DA,1)=LONG
+23 LOCK -^FSCD("CALL USER",0)
+24 SET DIK="^FSCD(""CALL USER"","
+25 DO IX1^DIK
End DoDot:1
+26 DO MRE^FSCMR(DUZ,CALL)
+27 IF $GET(^TMP("FSCRPC",$JOB,"INPUT",5))'="{NOTE}"
QUIT
+28 KILL ^FSCD("CALL USER",DA,2)
+29 SET CNT=0
+30 SET NUM=5
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
if LINE="{{{}}}"
QUIT
Begin DoDot:1
+31 SET CNT=CNT+1
+32 SET ^FSCD("CALL USER",DA,2,CNT,0)=LINE
End DoDot:1
+33 IF CNT
SET ^FSCD("CALL USER",DA,2,0)="^^"_CNT_U_CNT_U_DT_U
+34 SET OK=1
Begin DoDot:1
+35 if $LENGTH($PIECE(^FSCD("CALL USER",DA,0),U,3))
QUIT
if $LENGTH($PIECE(^(0),U,4))
QUIT
if $LENGTH($GET(^(1)))
QUIT
if $ORDER(^(2,0))
QUIT
+36 SET OK=0
End DoDot:1
+37 IF 'OK
DO DEL^FSCUCD("^FSCD(""CALL USER"",",DA)
+38 QUIT
+39 ;
GET(IN,OUT) ; from FSCRPX (RPCGetPersonalFields)
+1 NEW CALL,CNT,IEN,LINE,LONG,NUM,NUMBER,SHORT
+2 SET CALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 SET IEN=+$GET(^FSCD("CALL USER","AUC",DUZ,CALL))
+4 IF 'IEN
QUIT
+5 SET ZERO=$GET(^FSCD("CALL USER",IEN,0))
+6 SET SHORT=$PIECE(ZERO,U,3)
+7 SET NUMBER=$PIECE(ZERO,U,4)
+8 SET LONG=$GET(^FSCD("CALL USER",IEN,1))
+9 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="SHORT^"_SHORT
+10 SET ^TMP("FSCRPC",$JOB,"OUTPUT",2)="NUMBER^"_NUMBER
+11 SET ^TMP("FSCRPC",$JOB,"OUTPUT",3)="LONG^"_LONG
+12 SET CNT=3
+13 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("CALL USER",IEN,2,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+14 SET CNT=CNT+1
+15 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
+16 QUIT
+17 ;
CALL(IN,OUT) ; from FSCRPX (RPCCallPersonal)
+1 NEW CALL,CNT,IEN,LINE,LONG,NUM,NUMBER,SHORT
+2 SET CALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 SET CALLID=$PIECE($GET(^FSCD("CALL",CALL,0)),U)
+4 SET IEN=+$GET(^FSCD("CALL USER","AUC",DUZ,CALL))
+5 IF 'IEN
Begin DoDot:1
+6 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="No information in personal fields for "_CALLID_"."
End DoDot:1
QUIT
+7 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="Personal Fields for "_CALLID_":"
+8 SET ZERO=$GET(^FSCD("CALL USER",IEN,0))
+9 SET SHORT=$PIECE(ZERO,U,3)
+10 SET NUMBER=$PIECE(ZERO,U,4)
+11 SET LONG=$GET(^FSCD("CALL USER",IEN,1))
+12 SET ^TMP("FSCRPC",$JOB,"OUTPUT",2)="Short Text: "_SHORT
+13 SET ^TMP("FSCRPC",$JOB,"OUTPUT",3)="Number: "_NUMBER
+14 SET ^TMP("FSCRPC",$JOB,"OUTPUT",4)="Long Text: "_LONG
+15 SET ^TMP("FSCRPC",$JOB,"OUTPUT",5)="Note:"
+16 SET CNT=5
+17 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("CALL USER",IEN,2,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+18 SET CNT=CNT+1
+19 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
