Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCRPCPF

FSCRPCPF.m

Go to the documentation of this file.
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