YSXRAT4.m

YSXRAT4 ; COMPILED XREF FOR FILE #618.4 ; 10/15/04

 ; 

 S DIKZK=1

 S DIKZ(0)=$G(^YSG("INP",DA,0))

 S X=$P(DIKZ(0),U,1)

 I X'="" S ^YSG("INP","B",$E(X,1,30),DA)=""

 S X=$P(DIKZ(0),U,2)

 I X'="" S ^YSG("INP","C",$E(X,1,30),DA)=""

 S X=$P(DIKZ(0),U,2)

 I X'="" I $P($G(^YSG("INP",DA,7)),U,4) S ^YSG("INP","CP",X,DA)=""

 S X=$P(DIKZ(0),U,3)

 I X'="" S ^YSG("INP","AIN",9999999-X,DA)=""

 S X=$P(DIKZ(0),U,4)

 I X'="" D CROSS^YSCEN5

 S X=$P(DIKZ(0),U,4)

 I X'="" D

 .N DIK,DIV,DIU,DIN

 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^YSG("INP",D0,7)):^(7),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(618.4,3,1,2,1.4)

 S DIKZ(0)=$G(^YSG("INP",DA,0))

 S X=$P(DIKZ(0),U,5)

 I X'="" I $D(^YSG("INP",DA,7)),$P(^YSG("INP",DA,7),U,4)?1N.N S ^YSG("INP","AC",X,DA)=""

 S X=$P(DIKZ(0),U,6)

 I X'="" I $D(^YSG("INP",DA,7)),$P(^YSG("INP",DA,7),U,4)?1N.N S ^YSG("INP","ACP",X,DA)=""

 S X=$P(DIKZ(0),U,7)

 I X'="" I $D(^YSG("INP",DA,7)),$P(^YSG("INP",DA,7),U,4)?1N.N S ^YSG("INP","ACR",X,DA)=""

 S DIKZ(7)=$G(^YSG("INP",DA,7))

 S X=$P(DIKZ(7),U,2)

 I X'="" S ^YSG("INP","AOUT",9999999-X,DA)=""

 S X=$P(DIKZ(7),U,4)

 I X'="" D ENTRY^YSCEN5

END G ^YSXRAT5

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YSXRAT4   1183     printed  Apr 09, 2024@21:19:06                                                                                                                                                                                                     Page 2

YSXRAT4   ; COMPILED XREF FOR FILE #618.4 ; 10/15/04

 +1       ; 

 +2        SET DIKZK=1

 +3        SET DIKZ(0)=$GET(^YSG("INP",DA,0))

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

 +5        IF X'=""

               SET ^YSG("INP","B",$EXTRACT(X,1,30),DA)=""

 +6        SET X=$PIECE(DIKZ(0),U,2)

 +7        IF X'=""

               SET ^YSG("INP","C",$EXTRACT(X,1,30),DA)=""

 +8        SET X=$PIECE(DIKZ(0),U,2)

 +9        IF X'=""

               IF $PIECE($GET(^YSG("INP",DA,7)),U,4)

                   SET ^YSG("INP","CP",X,DA)=""

 +10       SET X=$PIECE(DIKZ(0),U,3)

 +11       IF X'=""

               SET ^YSG("INP","AIN",9999999-X,DA)=""

 +12       SET X=$PIECE(DIKZ(0),U,4)

 +13       IF X'=""

               DO CROSS^YSCEN5

 +14       SET X=$PIECE(DIKZ(0),U,4)

 +15       IF X'=""

               Begin DoDot:1

 +16               NEW DIK,DIV,DIU,DIN

 +17               KILL DIV

                   SET DIV=X

                   SET D0=DA

                   SET DIV(0)=D0

                   SET Y(1)=$SELECT($DATA(^YSG("INP",D0,7)):^(7),1:"")

                   SET X=$PIECE(Y(1),U,4)

                   SET X=X

                   SET DIU=X

                   KILL Y

                   SET X=DIV

                   SET X=DIV

                   SET X=X

                   XECUTE ^DD(618.4,3,1,2,1.4)

               End DoDot:1

 +18       SET DIKZ(0)=$GET(^YSG("INP",DA,0))

 +19       SET X=$PIECE(DIKZ(0),U,5)

 +20       IF X'=""

               IF $DATA(^YSG("INP",DA,7))

                   IF $PIECE(^YSG("INP",DA,7),U,4)?1N.N

                       SET ^YSG("INP","AC",X,DA)=""

 +21       SET X=$PIECE(DIKZ(0),U,6)

 +22       IF X'=""

               IF $DATA(^YSG("INP",DA,7))

                   IF $PIECE(^YSG("INP",DA,7),U,4)?1N.N

                       SET ^YSG("INP","ACP",X,DA)=""

 +23       SET X=$PIECE(DIKZ(0),U,7)

 +24       IF X'=""

               IF $DATA(^YSG("INP",DA,7))

                   IF $PIECE(^YSG("INP",DA,7),U,4)?1N.N

                       SET ^YSG("INP","ACR",X,DA)=""

 +25       SET DIKZ(7)=$GET(^YSG("INP",DA,7))

 +26       SET X=$PIECE(DIKZ(7),U,2)

 +27       IF X'=""

               SET ^YSG("INP","AOUT",9999999-X,DA)=""

 +28       SET X=$PIECE(DIKZ(7),U,4)

 +29       IF X'=""

               DO ENTRY^YSCEN5

END        GOTO ^YSXRAT5