- ORX1 ; SLC/DCM - OE/RR Nature of Order entry points ;Apr 24, 2024@07:20:01
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242,535**;Dec 17, 1997;Build 20
- ;Reference to ^DIC(9.4,"C" in ICR #2058
- ;Reference to ^DIC in ICR #10006
- ;Reference to MIX^DIC1 in ICR #10007
- ;Reference to ^DIE in ICR #10018
- ;Reference to ^DIR in ICR #10026
- ;
- NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
- ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
- ; Used for default response.
- ;REQUIRD [not required] =1 to require a response from user,
- ; =0 (default) not to require response.
- ;FB [not required] =F for frontdoor,
- ; =B (default) for backdoor.
- ; Screens on Frontdoor/Backdoor types.
- ; Nature of order entries are setup to be available for
- ; frontdoor or backdoor processing.
- ;DIRA [not required] =prompt for DIR("A")
- ; default:"Reason for Order/Change"
- ;DC [not required] =1 if you want to include 'DC only' types,
- ; =0 (default) includes all other types except for 'DC only'.
- ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
- ; allowed. If this is passed, then DC and FB params
- ; are ignored. Format: code1code2code3
- ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
- ;Returned value: ifn^name^code
- N DIR,X,Y,DIRUT,DUOUT
- S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- S DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
- S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
- S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
- S DIR("?",5)=""
- S DIR("?",6)=" Enter '??' for more information."
- S DIR("?")=" "
- S DIR("A")=$S($L($G(DIRA)):DIRA,1:"Reason for Order/Change")
- I '$G(DEFAULT),$L($G(DEFAULT)),$O(^ORD(100.02,"C",DEFAULT,0)) S DEFAULT=$O(^(0))
- I $G(DEFAULT) S DIR("B")=$S($D(^ORD(100.02,+DEFAULT,0)):$S('$L($G(LIST)):$P(^(0),"^"),1:$S($L($G(LIST))&($G(LIST)[$P(^(0),"^",2)):$P(^(0),"^"),1:""),1:""),1:"") K:DIR("B")="" DIR("B")
- S DIR(0)="P^100.02:EMZ"
- S:'$D(FB) FB="B" S:FB="" FB="B" S:'$D(DC) DC=0
- I $L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
- I '$L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),""^"",6)!(DC)),"_$S(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"",5)",1:0)
- S DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
- S DIR("??")="^D NA1^ORX1(DIR(""S""))"
- OT2 D ^DIR
- I 'Y,$G(REQUIRD)=1 W !,"A "_$S($L($G(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$C(7),! G OT2
- I Y S $P(Y,"^",3)=$P(^ORD(100.02,+Y,0),"^",2)
- Q Y
- NA1(SCREEN) ;Executable help for Nature of order
- ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
- N X,X1,Y
- W !?30," Require",?43," Print",?56,"Print on"
- W !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
- W !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
- S Y=0 F S Y=$O(^ORD(100.02,Y)) Q:Y<1 I $D(^(Y,0)) X:$D(SCREEN) SCREEN I $T S X=^ORD(100.02,Y,0),X1=$G(^(1)) W !,?2,$P(X,"^"),?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
- Q
- NA2(SCREEN) ;Get help for DC Reasons
- ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
- N X,X1,I
- W !?30," Require",?43," Print",?56,"Print on"
- W !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
- W !,"------------",?29,"-----------",?43,"----------",?56,"--------"
- S I=0 F S I=$O(^ORD(100.03,I)) Q:I<1 I $D(^(I,0)) X:$D(SCREEN) SCREEN I $T S X=^(0) I $P(X,"^",7),$D(^ORD(100.02,$P(X,"^",7),0)) W !,$P(X,"^") S X=^(0),X1=$G(^(1)) D
- . W ?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
- Q
- ;
- CREATE(X) ; -- Returns 1 or 0, if action should be created or not
- N Y Q:'$L($G(X)) 0
- I 'X S X=+$O(^ORD(100.02,"C",X,0))
- S Y=+$P($G(^ORD(100.02,+X,1)),U)
- Q Y
- ;
- SIGSTS(X) ; -- Returns default signature status for nature X
- N Y S Y="" G:'$L($G(X)) SIGQ
- I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X SIGQ
- S Y=$P($G(^ORD(100.02,+X,1)),U,4)
- SIGQ Q Y
- ;
- CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
- N Y S Y="" G:'$L($G(X)) CHQ
- I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X CHQ
- S Y=$P($G(^ORD(100.02,+X,1)),U,2)
- CHQ Q Y
- ;
- ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
- N Y S Y="" G:'$L($G(X)) ACTQ
- I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X ACTQ
- S Y=$P($G(^ORD(100.02,+X,1)),U,6)
- ACTQ Q Y
- ;
- DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
- ;DEFAULT=ifn of default reason
- ;REQ=1 to require a response
- ;PKG=ptr to file 9.4 to only get reasons for a specific package
- ;DIRA=Default prompt to be used instead of DIR("A")
- N DIR,X,Y,DIRUT,DUOUT
- S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- S DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
- S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
- S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
- S DIR("?",5)=""
- S DIR("?")=" "
- S DIR("A")="Reason" I $L($G(DIRA)) S DIR("A")=DIRA
- I $G(DEFAULT) S DIR("B")=$S($G(DEFAULT):$S($D(^ORD(100.03,+DEFAULT,0)):$P(^(0),"^"),1:""),1:"")
- S DIR(0)="P^100.03:EMZ"
- S DIR("S")="I '$P(^(0),""^"",4)"_$S($G(PKG):",$P(^(0),""^"",5)=PKG",1:"")
- S DIR("??")="^D NA2^ORX1(DIR(""S""))"
- OT1 D ^DIR
- I 'Y,$G(REQ)=1 W !,"A REASON FOR DC must be entered",$C(7),! G OT1
- Q $S(Y:+Y_"^"_$G(Y(0)),1:Y)
- ;
- EDITDCR ; -- Edit DC Reason
- N X,Y,D,DIC,DIE,DR,DA,DLAYGO W !
- EDC1 S DIC=100.03,DIC(0)="AELNQM",DIC("A")="Select DC REASON: ",DLAYGO=100.03
- S DIC("S")="I $P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0)),D="B^S"
- S DIC("DR")=".05////"_+$O(^DIC(9.4,"C","OR",0)) D MIX^DIC1 Q:Y'>0
- S DA=+Y,DIE=DIC,DR=".01;.03;.04;.07" D ^DIE
- W ! G EDC1
- Q
- ;
- EDITNAT ; -- Edit allowable Nature of Order fields
- N X,Y,DA,DR,DIE,DIC W !
- EDN S DIC="^ORD(100.02,",DIC(0)="AEQM",DIC("A")="Select NATURE OF ORDER: "
- S DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
- D ^DIC Q:Y<1
- S DA=+Y,DIE=DIC,DR=".12;.13;.15;.16" D ^DIE
- W ! G EDN
- Q
- ;
- EDITOVR ; -- Edit Override Reason
- N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,NATIONAL W !
- EOVR1 S DIC=100.04,DIC(0)="AELNQ",DIC("A")="Select OVERRIDE REASON: ",DLAYGO=100.04,DIC("DR")=".01"
- D ^DIC Q:Y'>0
- S NATIONAL=+$P($G(^ORD(100.04,+Y,0)),U,5)
- S DA=+Y
- I 'NATIONAL D
- . S DIE=DIC,DIDEL=100.04,DR=".01;.02;.03;.04;.05///0" D ^DIE
- I NATIONAL D
- . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- . S DIR(0)="YA"
- . S DIR("A")="Do you want to view the contents of the Override Reason? "
- . S DIR("A",1)=""
- . S DIR("A",2)=" *************************************************"
- . S DIR("A",3)=" * You have selected a National Override Reason. *"
- . S DIR("A",4)=" * You CANNOT edit this entry. *"
- . S DIR("A",5)=" *************************************************"
- . S DIR("A",6)=""
- . S DIR("B")="NO"
- . D ^DIR
- . I Y=1 D
- .. N DIQ
- .. S DIQ(0)="R"
- .. W !
- .. D EN^DIQ
- W ! G EOVR1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORX1 7488 printed Jan 18, 2025@03:39 Page 2
- ORX1 ; SLC/DCM - OE/RR Nature of Order entry points ;Apr 24, 2024@07:20:01
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242,535**;Dec 17, 1997;Build 20
- +2 ;Reference to ^DIC(9.4,"C" in ICR #2058
- +3 ;Reference to ^DIC in ICR #10006
- +4 ;Reference to MIX^DIC1 in ICR #10007
- +5 ;Reference to ^DIE in ICR #10018
- +6 ;Reference to ^DIR in ICR #10026
- +7 ;
- NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
- +1 ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
- +2 ; Used for default response.
- +3 ;REQUIRD [not required] =1 to require a response from user,
- +4 ; =0 (default) not to require response.
- +5 ;FB [not required] =F for frontdoor,
- +6 ; =B (default) for backdoor.
- +7 ; Screens on Frontdoor/Backdoor types.
- +8 ; Nature of order entries are setup to be available for
- +9 ; frontdoor or backdoor processing.
- +10 ;DIRA [not required] =prompt for DIR("A")
- +11 ; default:"Reason for Order/Change"
- +12 ;DC [not required] =1 if you want to include 'DC only' types,
- +13 ; =0 (default) includes all other types except for 'DC only'.
- +14 ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
- +15 ; allowed. If this is passed, then DC and FB params
- +16 ; are ignored. Format: code1code2code3
- +17 ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
- +18 ;Returned value: ifn^name^code
- +19 NEW DIR,X,Y,DIRUT,DUOUT
- +20 SET DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- +21 SET DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
- +22 SET DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
- +23 SET DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
- +24 SET DIR("?",5)=""
- +25 SET DIR("?",6)=" Enter '??' for more information."
- +26 SET DIR("?")=" "
- +27 SET DIR("A")=$SELECT($LENGTH($GET(DIRA)):DIRA,1:"Reason for Order/Change")
- +28 IF '$GET(DEFAULT)
- IF $LENGTH($GET(DEFAULT))
- IF $ORDER(^ORD(100.02,"C",DEFAULT,0))
- SET DEFAULT=$ORDER(^(0))
- +29 IF $GET(DEFAULT)
- SET DIR("B")=$SELECT($DATA(^ORD(100.02,+DEFAULT,0)):$SELECT('$LENGTH($GET(LIST)):$PIECE(^(0),"^"),1:$SELECT($LENGTH($GET(LIST))&($GET(LIST)[$PIECE(^(0),"^",2)):$PIECE(^(0),"^"),1:""),1:""),1:"")
- if DIR("B")=""
- KILL DIR("B")
- +30 SET DIR(0)="P^100.02:EMZ"
- +31 if '$DATA(FB)
- SET FB="B"
- if FB=""
- SET FB="B"
- if '$DATA(DC)
- SET DC=0
- +32 IF $LENGTH($GET(LIST))
- SET DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
- +33 IF '$LENGTH($GET(LIST))
- SET DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),""^"",6)!(DC)),"_$SELECT(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"",5)",1:0)
- +34 ;inactive VUID
- SET DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")"
- +35 SET DIR("??")="^D NA1^ORX1(DIR(""S""))"
- OT2 DO ^DIR
- +1 IF 'Y
- IF $GET(REQUIRD)=1
- WRITE !,"A "_$SELECT($LENGTH($GET(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$CHAR(7),!
- GOTO OT2
- +2 IF Y
- SET $PIECE(Y,"^",3)=$PIECE(^ORD(100.02,+Y,0),"^",2)
- +3 QUIT Y
- NA1(SCREEN) ;Executable help for Nature of order
- +1 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
- +2 NEW X,X1,Y
- +3 WRITE !?30," Require",?43," Print",?56,"Print on"
- +4 WRITE !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
- +5 WRITE !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
- +6 SET Y=0
- FOR
- SET Y=$ORDER(^ORD(100.02,Y))
- if Y<1
- QUIT
- IF $DATA(^(Y,0))
- if $DATA(SCREEN)
- XECUTE SCREEN
- IF $TEST
- SET X=^ORD(100.02,Y,0)
- SET X1=$GET(^(1))
- WRITE !,?2,$PIECE(X,"^"),?34,$SELECT($PIECE(X1,"^",4)=2:"x",1:""),?47,$SELECT($PIECE(X1,"^",2):"x",1:""),?59,$SELECT($PIECE(X1,"^",3):"x",1:"")
- +7 QUIT
- NA2(SCREEN) ;Get help for DC Reasons
- +1 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
- +2 NEW X,X1,I
- +3 WRITE !?30," Require",?43," Print",?56,"Print on"
- +4 WRITE !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
- +5 WRITE !,"------------",?29,"-----------",?43,"----------",?56,"--------"
- +6 SET I=0
- FOR
- SET I=$ORDER(^ORD(100.03,I))
- if I<1
- QUIT
- IF $DATA(^(I,0))
- if $DATA(SCREEN)
- XECUTE SCREEN
- IF $TEST
- SET X=^(0)
- IF $PIECE(X,"^",7)
- IF $DATA(^ORD(100.02,$PIECE(X,"^",7),0))
- WRITE !,$PIECE(X,"^")
- SET X=^(0)
- SET X1=$GET(^(1))
- Begin DoDot:1
- +7 WRITE ?34,$SELECT($PIECE(X1,"^",4)=2:"x",1:""),?47,$SELECT($PIECE(X1,"^",2):"x",1:""),?59,$SELECT($PIECE(X1,"^",3):"x",1:"")
- End DoDot:1
- +8 QUIT
- +9 ;
- CREATE(X) ; -- Returns 1 or 0, if action should be created or not
- +1 NEW Y
- if '$LENGTH($GET(X))
- QUIT 0
- +2 IF 'X
- SET X=+$ORDER(^ORD(100.02,"C",X,0))
- +3 SET Y=+$PIECE($GET(^ORD(100.02,+X,1)),U)
- +4 QUIT Y
- +5 ;
- SIGSTS(X) ; -- Returns default signature status for nature X
- +1 NEW Y
- SET Y=""
- if '$LENGTH($GET(X))
- GOTO SIGQ
- +2 IF 'X
- SET X=+$ORDER(^ORD(100.02,"C",X,0))
- if 'X
- GOTO SIGQ
- +3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,4)
- SIGQ QUIT Y
- +1 ;
- CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
- +1 NEW Y
- SET Y=""
- if '$LENGTH($GET(X))
- GOTO CHQ
- +2 IF 'X
- SET X=+$ORDER(^ORD(100.02,"C",X,0))
- if 'X
- GOTO CHQ
- +3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,2)
- CHQ QUIT Y
- +1 ;
- ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
- +1 NEW Y
- SET Y=""
- if '$LENGTH($GET(X))
- GOTO ACTQ
- +2 IF 'X
- SET X=+$ORDER(^ORD(100.02,"C",X,0))
- if 'X
- GOTO ACTQ
- +3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,6)
- ACTQ QUIT Y
- +1 ;
- DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
- +1 ;DEFAULT=ifn of default reason
- +2 ;REQ=1 to require a response
- +3 ;PKG=ptr to file 9.4 to only get reasons for a specific package
- +4 ;DIRA=Default prompt to be used instead of DIR("A")
- +5 NEW DIR,X,Y,DIRUT,DUOUT
- +6 SET DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- +7 SET DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
- +8 SET DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
- +9 SET DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
- +10 SET DIR("?",5)=""
- +11 SET DIR("?")=" "
- +12 SET DIR("A")="Reason"
- IF $LENGTH($GET(DIRA))
- SET DIR("A")=DIRA
- +13 IF $GET(DEFAULT)
- SET DIR("B")=$SELECT($GET(DEFAULT):$SELECT($DATA(^ORD(100.03,+DEFAULT,0)):$PIECE(^(0),"^"),1:""),1:"")
- +14 SET DIR(0)="P^100.03:EMZ"
- +15 SET DIR("S")="I '$P(^(0),""^"",4)"_$SELECT($GET(PKG):",$P(^(0),""^"",5)=PKG",1:"")
- +16 SET DIR("??")="^D NA2^ORX1(DIR(""S""))"
- OT1 DO ^DIR
- +1 IF 'Y
- IF $GET(REQ)=1
- WRITE !,"A REASON FOR DC must be entered",$CHAR(7),!
- GOTO OT1
- +2 QUIT $SELECT(Y:+Y_"^"_$GET(Y(0)),1:Y)
- +3 ;
- EDITDCR ; -- Edit DC Reason
- +1 NEW X,Y,D,DIC,DIE,DR,DA,DLAYGO
- WRITE !
- EDC1 SET DIC=100.03
- SET DIC(0)="AELNQM"
- SET DIC("A")="Select DC REASON: "
- SET DLAYGO=100.03
- +1 SET DIC("S")="I $P(^(0),U,5)="_+$ORDER(^DIC(9.4,"C","OR",0))
- SET D="B^S"
- +2 SET DIC("DR")=".05////"_+$ORDER(^DIC(9.4,"C","OR",0))
- DO MIX^DIC1
- if Y'>0
- QUIT
- +3 SET DA=+Y
- SET DIE=DIC
- SET DR=".01;.03;.04;.07"
- DO ^DIE
- +4 WRITE !
- GOTO EDC1
- +5 QUIT
- +6 ;
- EDITNAT ; -- Edit allowable Nature of Order fields
- +1 NEW X,Y,DA,DR,DIE,DIC
- WRITE !
- EDN SET DIC="^ORD(100.02,"
- SET DIC(0)="AEQM"
- SET DIC("A")="Select NATURE OF ORDER: "
- +1 ;inactive VUID
- SET DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")"
- +2 DO ^DIC
- if Y<1
- QUIT
- +3 SET DA=+Y
- SET DIE=DIC
- SET DR=".12;.13;.15;.16"
- DO ^DIE
- +4 WRITE !
- GOTO EDN
- +5 QUIT
- +6 ;
- EDITOVR ; -- Edit Override Reason
- +1 NEW X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,NATIONAL
- WRITE !
- EOVR1 SET DIC=100.04
- SET DIC(0)="AELNQ"
- SET DIC("A")="Select OVERRIDE REASON: "
- SET DLAYGO=100.04
- SET DIC("DR")=".01"
- +1 DO ^DIC
- if Y'>0
- QUIT
- +2 SET NATIONAL=+$PIECE($GET(^ORD(100.04,+Y,0)),U,5)
- +3 SET DA=+Y
- +4 IF 'NATIONAL
- Begin DoDot:1
- +5 SET DIE=DIC
- SET DIDEL=100.04
- SET DR=".01;.02;.03;.04;.05///0"
- DO ^DIE
- End DoDot:1
- +6 IF NATIONAL
- Begin DoDot:1
- +7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +8 SET DIR(0)="YA"
- +9 SET DIR("A")="Do you want to view the contents of the Override Reason? "
- +10 SET DIR("A",1)=""
- +11 SET DIR("A",2)=" *************************************************"
- +12 SET DIR("A",3)=" * You have selected a National Override Reason. *"
- +13 SET DIR("A",4)=" * You CANNOT edit this entry. *"
- +14 SET DIR("A",5)=" *************************************************"
- +15 SET DIR("A",6)=""
- +16 SET DIR("B")="NO"
- +17 DO ^DIR
- +18 IF Y=1
- Begin DoDot:2
- +19 NEW DIQ
- +20 SET DIQ(0)="R"
- +21 WRITE !
- +22 DO EN^DIQ
- End DoDot:2
- End DoDot:1
- +23 WRITE !
- GOTO EOVR1
- +24 QUIT