FSCRPCUF.m

FSCRPCUF ;SLC/STAFF-NOIS RPC User Formats ;1/13/98  16:13

 ;;1.1;NOIS;;Sep 06, 1998

 ;

DEL(IN,OUT) ; from FSCRPX (RPCDeleteFormat)

 N NUM

 S NUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))

 I 'NUM Q

 D DEL^FSCUCD("^FSC(""FORMAT"",",NUM)

 Q

 ;

SETUP(IN,OUT) ; from FSCRPX (RPCSetupFormat)

 N CNT,DA,DIK,LINE,NAME,NUM,OK,TYPE

 S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1))

 I '$L(LINE) Q

 S DA=+LINE,NAME=$P(LINE,U,2),TYPE=$P(LINE,U,3)

 I '$L(NAME) Q

 I '(TYPE="S"!(TYPE="F")) Q

 S NAME=$$UP^XLFSTR(NAME),NAME=$TR(NAME,";""^","~~~")

 I DA D

 .S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ

 .K ^FSC("FORMAT","B",DA)

 .K ^FSC("FORMAT",DA,2)

 E  D  I 'OK Q

 .S OK=1

 .L +^FSC("FORMAT",0):30 I '$T S OK=0 Q

 .S DA=1+$P(^FSC("FORMAT",0),U,3)

 .F  Q:'$D(^FSC("FORMAT",DA,0))  S DA=DA+1

 .S $P(^FSC("FORMAT",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1

 .S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ

 .L -^FSC("FORMAT",0)

 S DIK="^FSC(""FORMAT"","

 S CNT=0,NUM=1 F  S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1  S LINE=^(NUM) D

 .S CNT=CNT+1

 .S ^FSC("FORMAT",DA,2,CNT,0)=LINE

 S ^FSC("FORMAT",DA,2,0)="^7107.62P^"_CNT_U_CNT

 D IX1^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FSCRPCUF   1143     printed  Apr 09, 2024@21:23:47                                                                                                                                                                                                    Page 2

FSCRPCUF  ;SLC/STAFF-NOIS RPC User Formats ;1/13/98  16:13

 +1       ;;1.1;NOIS;;Sep 06, 1998

 +2       ;

DEL(IN,OUT) ; from FSCRPX (RPCDeleteFormat)

 +1        NEW NUM

 +2        SET NUM=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))

 +3        IF 'NUM

               QUIT 

 +4        DO DEL^FSCUCD("^FSC(""FORMAT"",",NUM)

 +5        QUIT 

 +6       ;

SETUP(IN,OUT) ; from FSCRPX (RPCSetupFormat)

 +1        NEW CNT,DA,DIK,LINE,NAME,NUM,OK,TYPE

 +2        SET LINE=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))

 +3        IF '$LENGTH(LINE)

               QUIT 

 +4        SET DA=+LINE

           SET NAME=$PIECE(LINE,U,2)

           SET TYPE=$PIECE(LINE,U,3)

 +5        IF '$LENGTH(NAME)

               QUIT 

 +6        IF '(TYPE="S"!(TYPE="F"))

               QUIT 

 +7        SET NAME=$$UP^XLFSTR(NAME)

           SET NAME=$TRANSLATE(NAME,";""^","~~~")

 +8        IF DA

               Begin DoDot:1

 +9                SET ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ

 +10               KILL ^FSC("FORMAT","B",DA)

 +11               KILL ^FSC("FORMAT",DA,2)

               End DoDot:1

 +12      IF '$TEST

               Begin DoDot:1

 +13               SET OK=1

 +14               LOCK +^FSC("FORMAT",0):30

                   IF '$TEST

                       SET OK=0

                       QUIT 

 +15               SET DA=1+$PIECE(^FSC("FORMAT",0),U,3)

 +16               FOR 

                       if '$DATA(^FSC("FORMAT",DA,0))

                           QUIT 

                       SET DA=DA+1

 +17               SET $PIECE(^FSC("FORMAT",0),U,3)=DA

                   SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +18               SET ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ

 +19               LOCK -^FSC("FORMAT",0)

               End DoDot:1

               IF 'OK

                   QUIT 

 +20       SET DIK="^FSC(""FORMAT"","

 +21       SET CNT=0

           SET NUM=1

           FOR 

               SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))

               if NUM<1

                   QUIT 

               SET LINE=^(NUM)

               Begin DoDot:1

 +22               SET CNT=CNT+1

 +23               SET ^FSC("FORMAT",DA,2,CNT,0)=LINE

               End DoDot:1

 +24       SET ^FSC("FORMAT",DA,2,0)="^7107.62P^"_CNT_U_CNT

 +25       DO IX1^DIK

 +26       QUIT