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 ---[H[J[2J[HYSXRAT4 1183 printed Dec 13, 2024@02:16:12 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
