PSGOER0 ;BIR/CML - EDIT FIELDS FOR RENEWAL ;Jul 26, 2017@18:04:02
;;5.0;INPATIENT MEDICATIONS;**11,45,47,50,63,64,70,69,58,80,110,127,136,181,281,327,372**;16 DEC 97;Build 153
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^VA(200 is supported by DBIA 10060.
; Reference to ^DD(55.06 is supported by DBIA 2253.
; Reference to ^%DT is supported by DBIA 10003.
; Reference to ^DIC is supported by DBIA 10006.
; Reference to $$SDEA^XUSER supported by DBIA #2343.
; Reference to $$PRDEA^XUSER supported by DBIA #2343.
;
DATE(PSGP,PSGORD,PSGDT) ;
K PSGFOK,PSJNOO,PSGNEDFD,PSGOEPR,PSGOER0,PSGPDRG,PSGOER2,PSGWLL,PSGOERDP,PSGOFD,PSGPRN,PSGPRI,PSGOSD,PSGOPR,PSGRNSD,PSGS0XT,PSGS0Y,PSGST,PSGSCH,PSGSDN
S F1=55.06,PSGWLL=+$G(^PS(55,PSGP,5.1)),PSGOER0=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGPDRG=+$G(^(.2)),PSGOER2=$G(^(2))
NEW XX S XX=$$ACTIVE^PSJORREN(PSGP,PSGORD) S:+XX=2 PSGPDRG=$P(XX,U,2)
I '+XX W !,"No active Orderable Item was found.",! G DONE
S (PSGNEDFD,PSGOERDP)=$P($$GTNEDFD^PSGOE7("U",PSGPDRG),U)
S PSGSCH=$P(PSGOER2,"^"),PSGST=$P(PSGOER0,"^",7),PSGS0Y=$P(PSGOER2,"^",5),PSGS0XT=$P(PSGOER2,"^",6)
S PSGOEPR=+$P(PSGOER0,"^",2),(PSGOPR,PSGPR)=$S($P(PSJSYSU,";",2):DUZ,1:+PSGOEPR)
I $G(PSJSPEED) S PSGPR=$S($P(ND,"^",2):$P(ND,"^",2),1:+PSGOEPR)
S PSGOSD=+$P(PSGOER2,"^",2) S PSGOFD=+$P(PSGOER2,"^",4),PSGPRN=$$GET1^DIQ(200,PSGPR,.01),PSGPRI=$S($P(PSJSYSU,";",2):0,1:$P($G(^("PS")),"^",4)),PSGRO=0 S:PSGPRI PSGPRI=PSGPRI'>DT I PSGPRI S (PSGOPR,PSGPR,PSGPRN)=""
S PSGRNSD=$S($G(PSGLI):PSGLI,1:$G(PSGDT))
S PSGSD=$G(PSGOSD)
I PSGSD="" S PSJREN=1,PSGSD=$$ENSD^PSGNE3($S(PSGST["P":"PRN",1:$P(PSGOER2,U)),PSGS0Y,PSGDT,PSGOSD) S:PSGOSD>PSGSD PSGSD=PSGOSD K PSJREN
S PSGSDN=$$ENDD^PSGMI(PSGSD)
10 ;
;W !,"START DATE/TIME: "_PSGSDN
O25 ;
N PSGSD,PSGNEFD S PSGSD=PSGDT
D ENWALL^PSGNE3(PSGSD,0,PSGP)
S:'$G(PSGDT) PSGDT=$$DATE2^PSJUTL2($$NOW^XLFDT)
N PSGNESD S PSGNESD=PSGDT D ENFD^PSGNE3(PSGNESD) I $G(PSGNEFD) S (Y,PSGFD)=PSGNEFD
S PSGFOK(10)="" I PSGST="O" S PSGFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGRNSD,PSGP) I PSGFD]"" S Y=PSGRNSD,X=0 G 1
D25 K DUR,DURMIN N PKGFLG S PKGFLG=$S(PSGORD["U":5,PSGORD["V":"IV",PSGORD["P":"P",1:"") I PKGFLG]"" S DUR=$$GETDUR^PSJLIVMD(PSGP,+$G(PSGORD),PKGFLG,1) I DUR]"" D
.S DURMIN=($$DURMIN^PSJLIVMD(DUR)\1) I DURMIN>1 S Y=$$FMADD^XLFDT(PSGRNSD,,,DURMIN) I Y>PSGRNSD S PSGFD=Y,X=0
I $P($G(PSGOER2),"^",4)>PSGFD S Y=$P(PSGOER2,"^",4)
I $G(DUR)]"",($G(PSGORD)'["P") S DURMIN=$$DURMIN^PSJLIVMD(DUR)\1 S Y=$$FMADD^XLFDT(PSGDT,,,DURMIN)
S:X&$P(PSJSYSW0,"^",7) $P(Y,".",2)=$P(PSJSYSW0,"^",7) S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
25 W !,"STOP DATE/TIME: "_PSGFDN_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
I X="" W " "_PSGFDN G W25
I $E(X)="^" D FF G:Y>0 @Y G 25
S PSGF2=25 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,25)
I X=+X,X>0,X'>2000000 G 25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X,ND2=PSGOER2,$P(ND2,"^",2)=PSGRNSD W " ...dose limit..." D ENGO^PSGDL
K %DT S %DT="ERTX" D ^%DT K %DT G:Y'>0 25 S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
W25 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
I PSGFD<PSGSD W $C(7),!!?3,"*** The STOP date must be AFTER the START date. ***" G 25
S PSGFOK(25)=""
;Display Expected First Dose;BHW;PSJ*5*136
D EFDNEW^PSJUTL
I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S PSGFOK(1)="" Q
1 ; provider
G:+PSJSYSU<3&$P(PSJSYSU,";",2) CHKDD S PSGF2=1
A1 ;
S PSTMPI=PSGPR,PSTMPN=PSGPRN
W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
I X="",PSGPR S X=PSGPRN ;I PSGPR'=PSGPRN,$$GET1^DIQ(200,PSGPR,53.1,"I") W " "_$$GET1^DIQ(200,PSGPR,53.2)_" "_$$GET1^DIQ(200,PSGPR,53.3) S PSGFOK(1)="" G:'$G(ANOX) OC55
I X?1."?" D ENHLP^PSGOEM(55.06,1)
I $E(X)="^" D FF G:Y>0 @Y G A1
K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="S X(1)=$G(^(""PS"")) I X(1),$S('$P((X(1)),""^"",4):1,1:DT<$P((X(1)),""^"",4))" D ^DIC K DIC I Y'>0 G A1
S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
;
;*372*
K PSJDEA,PDEA S PDEA=""
I $G(PSGPDRG)]"" D I (PDEA=1)!(PDEA=2)!(+PDEA=4) G A1
. N PSPPKG S PSPPKG=$S($G(PSJPROT)=1:"U",$G(PSJPROT)=3:"UI",1:"") Q:PSPPKG=""
. S PSJDEA=$$OIDEA^PSSOPKI(PSGPDRG,PSPPKG),PSJDEA=$P(PSJDEA,";",2)
. I PSJDEA S PDEA=$$SDEA^XUSER(,+PSGPR,PSJDEA,,"I") I (PDEA=1)!(PDEA=2)!(+PDEA=4) D Q
.. W !,"Provider not authorized to prescribe medications in Federal Schedule "_PSJDEA_".",!,"Please contact the provider.",!
. ;I $L($G(PSGPRN)) W " "_$$PRDEA^XUSER(PSGPR) I $D(^VA(200,PSGPR,"PS")) W " ",$P(^VA(200,PSGPR,"PS"),"^",3)
. I $L($G(PSGPRN)),(($E($G(PDEA),1,9))?2U7N) W " "_PDEA
;
;; START NCC T4 MODS >> 327*RJS
A2 D CLOZPRV^PSGOE82
I $G(ANQX) W ! S PSGPR=PSTMPI,PSGPRN=PSTMPN K PSTMPN,PSTMPI G A1
K ANQX
;; END NCC T4 MODS << 327*RJS
OC55 ;
;Order check for Speed finish is triggered from OC531^PSGOESF
I $G(PSGORD)]"P",$G(PSJSPEED) Q
I $G(PSJOCFG)="SPEED RENEW" G CHKDD
D NEWOC55^PSGOER
I $G(PSGORQF) S COMQUIT=1 G DONE
CHKDD ;
G:$G(PSGRENEW) 106
I PSGORD["P"!$$DDOK^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPDRG) G 106
;I PSGORD["P"!'$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") G 106
I $P(PSJSYSU,";")'=3,'$P(PSJSYSP0,U,2) W !!,"This order's dispense drug is invalid, a pharmacist must renew this order." Q
K ^PS(53.45,PSJSYSP,1),^(2)
W !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
D ENDRG^PSGOEF1(+$$GET1^DIQ(55.06,+PSGOED_","_PSGP,108,"I"),0)
I $G(DUOUT)!'$G(DRG) S COMQUIT=1 Q
106 ; nature of order
S PSJNOO=$$ENNOO^PSJUTL5("R") S:PSJNOO<0 COMQUIT=1
S:PSJNOO'<0 PSGFOK(106)=""
DONE ;
K F,F0,F1,PSGF2,F3,ND2,PSGDL,PSGDLS,PSGOROE1,PSGRO,SDT,X,Y Q
FF ; "^" to another field
K DIC S DIC="^DD(55.06,",DIC(0)="EQ",DIC("S")="I $D(PSGFOK(+Y))",X=$E(X,2,255) D ^DIC K DIC
S Y=+Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOER0 6004 printed Dec 13, 2024@02:02:22 Page 2
PSGOER0 ;BIR/CML - EDIT FIELDS FOR RENEWAL ;Jul 26, 2017@18:04:02
+1 ;;5.0;INPATIENT MEDICATIONS;**11,45,47,50,63,64,70,69,58,80,110,127,136,181,281,327,372**;16 DEC 97;Build 153
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^VA(200 is supported by DBIA 10060.
+5 ; Reference to ^DD(55.06 is supported by DBIA 2253.
+6 ; Reference to ^%DT is supported by DBIA 10003.
+7 ; Reference to ^DIC is supported by DBIA 10006.
+8 ; Reference to $$SDEA^XUSER supported by DBIA #2343.
+9 ; Reference to $$PRDEA^XUSER supported by DBIA #2343.
+10 ;
DATE(PSGP,PSGORD,PSGDT) ;
+1 KILL PSGFOK,PSJNOO,PSGNEDFD,PSGOEPR,PSGOER0,PSGPDRG,PSGOER2,PSGWLL,PSGOERDP,PSGOFD,PSGPRN,PSGPRI,PSGOSD,PSGOPR,PSGRNSD,PSGS0XT,PSGS0Y,PSGST,PSGSCH,PSGSDN
+2 SET F1=55.06
SET PSGWLL=+$GET(^PS(55,PSGP,5.1))
SET PSGOER0=$GET(^PS(55,PSGP,5,+PSGORD,0))
SET PSGPDRG=+$GET(^(.2))
SET PSGOER2=$GET(^(2))
+3 NEW XX
SET XX=$$ACTIVE^PSJORREN(PSGP,PSGORD)
if +XX=2
SET PSGPDRG=$PIECE(XX,U,2)
+4 IF '+XX
WRITE !,"No active Orderable Item was found.",!
GOTO DONE
+5 SET (PSGNEDFD,PSGOERDP)=$PIECE($$GTNEDFD^PSGOE7("U",PSGPDRG),U)
+6 SET PSGSCH=$PIECE(PSGOER2,"^")
SET PSGST=$PIECE(PSGOER0,"^",7)
SET PSGS0Y=$PIECE(PSGOER2,"^",5)
SET PSGS0XT=$PIECE(PSGOER2,"^",6)
+7 SET PSGOEPR=+$PIECE(PSGOER0,"^",2)
SET (PSGOPR,PSGPR)=$SELECT($PIECE(PSJSYSU,";",2):DUZ,1:+PSGOEPR)
+8 IF $GET(PSJSPEED)
SET PSGPR=$SELECT($PIECE(ND,"^",2):$PIECE(ND,"^",2),1:+PSGOEPR)
+9 SET PSGOSD=+$PIECE(PSGOER2,"^",2)
SET PSGOFD=+$PIECE(PSGOER2,"^",4)
SET PSGPRN=$$GET1^DIQ(200,PSGPR,.01)
SET PSGPRI=$SELECT($PIECE(PSJSYSU,";",2):0,1:$PIECE($GET(^("PS")),"^",4))
SET PSGRO=0
if PSGPRI
SET PSGPRI=PSGPRI'>DT
IF PSGPRI
SET (PSGOPR,PSGPR,PSGPRN)=""
+10 SET PSGRNSD=$SELECT($GET(PSGLI):PSGLI,1:$GET(PSGDT))
+11 SET PSGSD=$GET(PSGOSD)
+12 IF PSGSD=""
SET PSJREN=1
SET PSGSD=$$ENSD^PSGNE3($SELECT(PSGST["P":"PRN",1:$PIECE(PSGOER2,U)),PSGS0Y,PSGDT,PSGOSD)
if PSGOSD>PSGSD
SET PSGSD=PSGOSD
KILL PSJREN
+13 SET PSGSDN=$$ENDD^PSGMI(PSGSD)
10 ;
+1 ;W !,"START DATE/TIME: "_PSGSDN
O25 ;
+1 NEW PSGSD,PSGNEFD
SET PSGSD=PSGDT
+2 DO ENWALL^PSGNE3(PSGSD,0,PSGP)
+3 if '$GET(PSGDT)
SET PSGDT=$$DATE2^PSJUTL2($$NOW^XLFDT)
+4 NEW PSGNESD
SET PSGNESD=PSGDT
DO ENFD^PSGNE3(PSGNESD)
IF $GET(PSGNEFD)
SET (Y,PSGFD)=PSGNEFD
+5 SET PSGFOK(10)=""
IF PSGST="O"
SET PSGFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGRNSD,PSGP)
IF PSGFD]""
SET Y=PSGRNSD
SET X=0
GOTO 1
D25 KILL DUR,DURMIN
NEW PKGFLG
SET PKGFLG=$SELECT(PSGORD["U":5,PSGORD["V":"IV",PSGORD["P":"P",1:"")
IF PKGFLG]""
SET DUR=$$GETDUR^PSJLIVMD(PSGP,+$GET(PSGORD),PKGFLG,1)
IF DUR]""
Begin DoDot:1
+1 SET DURMIN=($$DURMIN^PSJLIVMD(DUR)\1)
IF DURMIN>1
SET Y=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
IF Y>PSGRNSD
SET PSGFD=Y
SET X=0
End DoDot:1
+2 IF $PIECE($GET(PSGOER2),"^",4)>PSGFD
SET Y=$PIECE(PSGOER2,"^",4)
+3 IF $GET(DUR)]""
IF ($GET(PSGORD)'["P")
SET DURMIN=$$DURMIN^PSJLIVMD(DUR)\1
SET Y=$$FMADD^XLFDT(PSGDT,,,DURMIN)
+4 if X&$PIECE(PSJSYSW0,"^",7)
SET $PIECE(Y,".",2)=$PIECE(PSJSYSW0,"^",7)
SET PSGFD=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)
25 WRITE !,"STOP DATE/TIME: "_PSGFDN_"// "
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
SET PSGRO=1
SET COMQUIT=1
GOTO DONE
+1 IF X=""
WRITE " "_PSGFDN
GOTO W25
+2 IF $EXTRACT(X)="^"
DO FF
if Y>0
GOTO @Y
GOTO 25
+3 SET PSGF2=25
IF X="@"!(X?1."?")
if X="@"
WRITE $CHAR(7)," (Required)"
if X="@"
SET X="?"
DO ENHLP^PSGOEM(55.06,25)
+4 IF X=+X
IF X>0
IF X'>2000000
if '$$ENDL^PSGDL(PSGSCH,X)
GOTO 25
KILL PSGDLS
SET PSGDL=X
SET ND2=PSGOER2
SET $PIECE(ND2,"^",2)=PSGRNSD
WRITE " ...dose limit..."
DO ENGO^PSGDL
+5 KILL %DT
SET %DT="ERTX"
DO ^%DT
KILL %DT
if Y'>0
GOTO 25
SET PSGFD=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)
W25 IF PSGFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
+1 IF PSGFD<PSGSD
WRITE $CHAR(7),!!?3,"*** The STOP date must be AFTER the START date. ***"
GOTO 25
+2 SET PSGFOK(25)=""
+3 ;Display Expected First Dose;BHW;PSJ*5*136
+4 DO EFDNEW^PSJUTL
+5 IF $GET(PSGONF)
IF (+$GET(PSGODDD(1))'<+$GET(PSGONF))
SET PSGFOK(1)=""
QUIT
1 ; provider
+1 if +PSJSYSU<3&$PIECE(PSJSYSU,";",2)
GOTO CHKDD
SET PSGF2=1
A1 ;
+1 SET PSTMPI=PSGPR
SET PSTMPN=PSGPRN
+2 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
SET PSGRO=1
SET COMQUIT=1
GOTO DONE
+3 IF $SELECT(X="":'PSGPR,1:X="@")
WRITE $CHAR(7)," (Required)"
SET X="?"
DO ENHLP^PSGOEM(55.06,1)
GOTO A1
+4 ;I PSGPR'=PSGPRN,$$GET1^DIQ(200,PSGPR,53.1,"I") W " "_$$GET1^DIQ(200,PSGPR,53.2)_" "_$$GET1^DIQ(200,PSGPR,53.3) S PSGFOK(1)="" G:'$G(ANOX) OC55
IF X=""
IF PSGPR
SET X=PSGPRN
+5 IF X?1."?"
DO ENHLP^PSGOEM(55.06,1)
+6 IF $EXTRACT(X)="^"
DO FF
if Y>0
GOTO @Y
GOTO A1
+7 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
SET DIC("S")="S X(1)=$G(^(""PS"")) I X(1),$S('$P((X(1)),""^"",4):1,1:DT<$P((X(1)),""^"",4))"
DO ^DIC
KILL DIC
IF Y'>0
GOTO A1
+8 SET PSGPR=+Y
SET PSGPRN=$PIECE(Y(0,0),"^")
SET PSGFOK(1)=""
+9 ;
+10 ;*372*
+11 KILL PSJDEA,PDEA
SET PDEA=""
+12 IF $GET(PSGPDRG)]""
Begin DoDot:1
+13 NEW PSPPKG
SET PSPPKG=$SELECT($GET(PSJPROT)=1:"U",$GET(PSJPROT)=3:"UI",1:"")
if PSPPKG=""
QUIT
+14 SET PSJDEA=$$OIDEA^PSSOPKI(PSGPDRG,PSPPKG)
SET PSJDEA=$PIECE(PSJDEA,";",2)
+15 IF PSJDEA
SET PDEA=$$SDEA^XUSER(,+PSGPR,PSJDEA,,"I")
IF (PDEA=1)!(PDEA=2)!(+PDEA=4)
Begin DoDot:2
+16 WRITE !,"Provider not authorized to prescribe medications in Federal Schedule "_PSJDEA_".",!,"Please contact the provider.",!
End DoDot:2
QUIT
+17 ;I $L($G(PSGPRN)) W " "_$$PRDEA^XUSER(PSGPR) I $D(^VA(200,PSGPR,"PS")) W " ",$P(^VA(200,PSGPR,"PS"),"^",3)
+18 IF $LENGTH($GET(PSGPRN))
IF (($EXTRACT($GET(PDEA),1,9))?2U7N)
WRITE " "_PDEA
End DoDot:1
IF (PDEA=1)!(PDEA=2)!(+PDEA=4)
GOTO A1
+19 ;
+20 ;; START NCC T4 MODS >> 327*RJS
A2 DO CLOZPRV^PSGOE82
+1 IF $GET(ANQX)
WRITE !
SET PSGPR=PSTMPI
SET PSGPRN=PSTMPN
KILL PSTMPN,PSTMPI
GOTO A1
+2 KILL ANQX
+3 ;; END NCC T4 MODS << 327*RJS
OC55 ;
+1 ;Order check for Speed finish is triggered from OC531^PSGOESF
+2 IF $GET(PSGORD)]"P"
IF $GET(PSJSPEED)
QUIT
+3 IF $GET(PSJOCFG)="SPEED RENEW"
GOTO CHKDD
+4 DO NEWOC55^PSGOER
+5 IF $GET(PSGORQF)
SET COMQUIT=1
GOTO DONE
CHKDD ;
+1 if $GET(PSGRENEW)
GOTO 106
+2 IF PSGORD["P"!$$DDOK^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPDRG)
GOTO 106
+3 ;I PSGORD["P"!'$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") G 106
+4 IF $PIECE(PSJSYSU,";")'=3
IF '$PIECE(PSJSYSP0,U,2)
WRITE !!,"This order's dispense drug is invalid, a pharmacist must renew this order."
QUIT
+5 KILL ^PS(53.45,PSJSYSP,1),^(2)
+6 WRITE !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
+7 DO ENDRG^PSGOEF1(+$$GET1^DIQ(55.06,+PSGOED_","_PSGP,108,"I"),0)
+8 IF $GET(DUOUT)!'$GET(DRG)
SET COMQUIT=1
QUIT
106 ; nature of order
+1 SET PSJNOO=$$ENNOO^PSJUTL5("R")
if PSJNOO<0
SET COMQUIT=1
+2 if PSJNOO'<0
SET PSGFOK(106)=""
DONE ;
+1 KILL F,F0,F1,PSGF2,F3,ND2,PSGDL,PSGDLS,PSGOROE1,PSGRO,SDT,X,Y
QUIT
FF ; "^" to another field
+1 KILL DIC
SET DIC="^DD(55.06,"
SET DIC(0)="EQ"
SET DIC("S")="I $D(PSGFOK(+Y))"
SET X=$EXTRACT(X,2,255)
DO ^DIC
KILL DIC
+2 SET Y=+Y
QUIT
