- OCXDI1 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- S ;
- ;
- Q
- ;
- ;
- COMPARE(L,R) ;
- ;
- Q:'$L($O(L(""))) $$ADDREC^OCXDI2("R")
- ;
- N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
- ;
- Q 0
- ;
- MULT(CREF,OCXDD) ;
- ;
- N OCXSUB,LREF,RREF,QUIT,OCXFLD
- S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
- S QUIT=0,OCXFLD="" F S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD) D Q:QUIT
- .I (OCXFLD[":") D Q:QUIT
- ..Q:$$EXFLD(+OCXFLD,0)
- ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
- ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
- ...S QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)
- ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
- ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
- ...S QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)
- .;
- .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
- ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D Q
- ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D Q
- ....D WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
- ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D Q
- ....D WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
- ....S QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
- ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
- ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- ..S OCXSUB=0 F Q:QUIT S OCXSUB=$O(@CREF@(OCXDD,OCXFLD,OCXSUB)) Q:'OCXSUB I '($G(@RREF@(OCXDD,OCXFLD,OCXSUB))=$G(@LREF@(OCXDD,OCXFLD,OCXSUB))) D Q
- ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
- ...S QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)
- .;
- .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
- Q QUIT
- ;
- APPEND(ARRAY,OCXSUB) ;
- S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
- Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
- Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
- ;
- EXFLD(FILE,OCXFLD) ;
- N OCXFNAM
- S OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
- I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
- I (FILE=860.2),(OCXFLD=.02) Q 1
- I (FILE=860.22),(OCXFLD=4) Q 1
- I (FILE=860.3),(OCXFLD=3) Q 1
- I (FILE=860.9),(OCXFLD=1) Q 1
- I (FILE=860.91) Q 1
- I (FILE=19),(OCXFLD=.15) Q 1
- I (FILE=19),(OCXFLD=.16) Q 1
- I (FILE=19),(OCXFLD=.26) Q 1
- I (FILE=19),(OCXFLD=1.1) Q 1
- I (FILE=19),(OCXFLD=3.6) Q 1
- I (FILE=19),(OCXFLD=14) Q 1
- I (FILE=19),(OCXFLD=99) Q 1
- I (FILE=19),(OCXFLD=99.1) Q 1
- I (FILE=19),(OCXFLD=200) Q 1
- I (FILE=19),(OCXFLD=201) Q 1
- I (FILE=19),(OCXFLD=203) Q 1
- I ($E(OCXFNAM,1)="*") Q 1
- Q 0
- ;
- WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
- ;
- Q:$G(OCXAUTO)
- ;
- N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
- ;
- Q:'OCXFLGR
- ;
- S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
- W !!,"----WARNING-",MSG,DASH
- D DSPHDR(CREF,OCXDD,OCXFLD)
- I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
- I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
- ;
- W ! Q
- ;
- DSPREC(CREF,OCXDD,OCXFLD) ;
- ;
- N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
- S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
- S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
- S OCXSUB="" F S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB) D
- .;
- .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
- ..N LINE
- ..Q:$$EXFLD(+OCXFLD,OCXSUB)
- ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
- ..S LINE=0 F S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE D
- ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
- .;
- .I (OCXSUB[":") D
- ..N D0,OCXDD,FILENAME
- ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
- ..S FILENAME=$$FILENAME^OCXBDTD(OCXDD)
- ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
- ..E W !!,?(5+(LEVL*4)),FILENAME
- ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
- ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
- ;
- Q
- ;
- DSPHDR(CREF,OCXDD,OCXFLD) ;
- ;
- N D0,FILE,FILEID,OCXPTR,OCXDDPTH
- S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
- S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
- .N OCXDD,D0,FILEID
- .S FILEID=$P(OCXDDPTH,",",OCXPTR)
- .I (FILEID[":") D
- ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
- ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)
- ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
- ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
- ..E I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
- ;
- Q
- ;
- DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
- ;
- N OCXDPTR,LREF,RREF,OCXDDPTH
- ;
- S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
- S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
- W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
- I OCXSUB W " Line #",OCXSUB
- ;
- W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) OEX,OER: ",@RREF@(OCXFLD,OCXSUB)
- W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)
- ;
- Q
- ;
- W !,?10 Q 0 Q $$PAUSE
- ;
- PAUSE() Q:'OCXFLGC 0 W " Press Enter " R X:DTIME W ! Q (X[U)
- ;
- NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI1 5461 printed Mar 13, 2025@21:29:22 Page 2
- OCXDI1 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
- +2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- +3 ;
- S ;
- +1 ;
- +2 QUIT
- +3 ;
- +4 ;
- COMPARE(L,R) ;
- +1 ;
- +2 if '$LENGTH($ORDER(L("")))
- QUIT $$ADDREC^OCXDI2("R")
- +3 ;
- +4 NEW C,OCXDD
- MERGE C=L,C=R
- SET OCXDD=$ORDER(C(""))
- QUIT $$MULT("C",OCXDD)
- +5 ;
- +6 QUIT 0
- +7 ;
- MULT(CREF,OCXDD) ;
- +1 ;
- +2 NEW OCXSUB,LREF,RREF,QUIT,OCXFLD
- +3 SET LREF="L"_$EXTRACT(CREF,2,$LENGTH(CREF))
- SET RREF="R"_$EXTRACT(CREF,2,$LENGTH(CREF))
- +4 SET QUIT=0
- SET OCXFLD=""
- FOR
- SET OCXFLD=$ORDER(@CREF@(OCXDD,OCXFLD))
- if '$LENGTH(OCXFLD)
- QUIT
- Begin DoDot:1
- +5 IF (OCXFLD[":")
- Begin DoDot:2
- +6 if $$EXFLD(+OCXFLD,0)
- QUIT
- +7 IF '$DATA(@LREF@(OCXDD,OCXFLD,.01,"E"))
- Begin DoDot:3
- +8 DO WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
- +9 SET QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)
- End DoDot:3
- MERGE @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
- +10 IF '$DATA(@RREF@(OCXDD,OCXFLD,.01,"E"))
- Begin DoDot:3
- +11 DO WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
- +12 SET QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)
- End DoDot:3
- MERGE @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
- End DoDot:2
- if QUIT
- QUIT
- +13 ;
- +14 IF (OCXFLD=+OCXFLD)
- IF '$$EXFLD(+OCXDD,OCXFLD)
- Begin DoDot:2
- +15 IF ($ORDER(@CREF@(OCXDD,OCXFLD,""))="E")
- Begin DoDot:3
- +16 IF $LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
- IF '$LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
- Begin DoDot:4
- +17 DO WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
- +18 SET QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- End DoDot:4
- QUIT
- +19 IF $LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
- IF '$LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
- Begin DoDot:4
- +20 DO WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
- +21 SET QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- End DoDot:4
- QUIT
- +22 IF '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E"))
- Begin DoDot:4
- +23 DO WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
- +24 SET QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
- End DoDot:4
- End DoDot:3
- QUIT
- +25 SET OCXSUB=0
- FOR
- if QUIT
- QUIT
- SET OCXSUB=$ORDER(@CREF@(OCXDD,OCXFLD,OCXSUB))
- if 'OCXSUB
- QUIT
- IF '($GET(@RREF@(OCXDD,OCXFLD,OCXSUB))=$GET(@LREF@(OCXDD,OCXFLD,OCXSUB)))
- Begin DoDot:3
- +26 DO WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
- +27 SET QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)
- End DoDot:3
- QUIT
- End DoDot:2
- +28 ;
- +29 IF 'QUIT
- IF (OCXFLD[":")
- SET QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
- End DoDot:1
- if QUIT
- QUIT
- +30 QUIT QUIT
- +31 ;
- APPEND(ARRAY,OCXSUB) ;
- +1 if '(OCXSUB=+OCXSUB)
- SET OCXSUB=""""_OCXSUB_""""
- +2 if '(ARRAY["(")
- QUIT ARRAY_"("_OCXSUB_")"
- +3 QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
- +4 ;
- EXFLD(FILE,OCXFLD) ;
- +1 NEW OCXFNAM
- +2 SET OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
- +3 IF (OCXFNAM["UNIQUE OBJECT IDENTIFIER")
- QUIT 1
- +4 IF (FILE=860.2)
- IF (OCXFLD=.02)
- QUIT 1
- +5 IF (FILE=860.22)
- IF (OCXFLD=4)
- QUIT 1
- +6 IF (FILE=860.3)
- IF (OCXFLD=3)
- QUIT 1
- +7 IF (FILE=860.9)
- IF (OCXFLD=1)
- QUIT 1
- +8 IF (FILE=860.91)
- QUIT 1
- +9 IF (FILE=19)
- IF (OCXFLD=.15)
- QUIT 1
- +10 IF (FILE=19)
- IF (OCXFLD=.16)
- QUIT 1
- +11 IF (FILE=19)
- IF (OCXFLD=.26)
- QUIT 1
- +12 IF (FILE=19)
- IF (OCXFLD=1.1)
- QUIT 1
- +13 IF (FILE=19)
- IF (OCXFLD=3.6)
- QUIT 1
- +14 IF (FILE=19)
- IF (OCXFLD=14)
- QUIT 1
- +15 IF (FILE=19)
- IF (OCXFLD=99)
- QUIT 1
- +16 IF (FILE=19)
- IF (OCXFLD=99.1)
- QUIT 1
- +17 IF (FILE=19)
- IF (OCXFLD=200)
- QUIT 1
- +18 IF (FILE=19)
- IF (OCXFLD=201)
- QUIT 1
- +19 IF (FILE=19)
- IF (OCXFLD=203)
- QUIT 1
- +20 IF ($EXTRACT(OCXFNAM,1)="*")
- QUIT 1
- +21 QUIT 0
- +22 ;
- WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
- +1 ;
- +2 if $GET(OCXAUTO)
- QUIT
- +3 ;
- +4 NEW D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
- +5 ;
- +6 if 'OCXFLGR
- QUIT
- +7 ;
- +8 SET DASH=""
- SET $PIECE(DASH,"-",(55-$LENGTH(MSG)))="-"
- +9 WRITE !!,"----WARNING-",MSG,DASH
- +10 DO DSPHDR(CREF,OCXDD,OCXFLD)
- +11 IF $DATA(OCXSUB)
- DO DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
- +12 IF '$DATA(OCXSUB)
- DO DSPREC(CREF,OCXDD,OCXFLD)
- +13 ;
- +14 WRITE !
- QUIT
- +15 ;
- DSPREC(CREF,OCXDD,OCXFLD) ;
- +1 ;
- +2 NEW OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
- +3 SET OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
- +4 SET OCXDDPTH=$PIECE($PIECE(OCXCREF,"(",2),")",1)
- SET LEVL=$LENGTH(OCXDDPTH,",")
- +5 SET OCXSUB=""
- FOR
- SET OCXSUB=$ORDER(@OCXCREF@(OCXSUB))
- if '$LENGTH(OCXSUB)
- QUIT
- Begin DoDot:1
- +6 ;
- +7 IF '(OCXSUB[":")
- IF '((OCXSUB=.01)&$ORDER(@OCXCREF@(OCXSUB)))
- Begin DoDot:2
- +8 NEW LINE
- +9 if $$EXFLD(+OCXFLD,OCXSUB)
- QUIT
- +10 IF OCXFLD
- WRITE !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$GET(@OCXCREF@(OCXSUB,"E"))
- +11 SET LINE=0
- FOR
- SET LINE=$ORDER(@OCXCREF@(OCXSUB,LINE))
- if 'LINE
- QUIT
- Begin DoDot:3
- +12 WRITE !,?(5+(LEVL*4)),$JUSTIFY(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
- End DoDot:3
- End DoDot:2
- +13 ;
- +14 IF (OCXSUB[":")
- Begin DoDot:2
- +15 NEW D0,OCXDD,FILENAME
- +16 SET D0=+$PIECE(OCXSUB,":",2)
- SET OCXDD=+OCXSUB
- +17 SET FILENAME=$$FILENAME^OCXBDTD(OCXDD)
- +18 IF $LENGTH(FILENAME)
- WRITE !,?(5+($LENGTH(LEVL)*4)),FILENAME
- +19 IF '$TEST
- WRITE !!,?(5+(LEVL*4)),FILENAME
- +20 WRITE " ",D0,": ",$GET(@OCXCREF@(OCXSUB,.01,"E"))
- +21 DO DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 QUIT
- +24 ;
- DSPHDR(CREF,OCXDD,OCXFLD) ;
- +1 ;
- +2 NEW D0,FILE,FILEID,OCXPTR,OCXDDPTH
- +3 SET OCXDDPTH=$PIECE($PIECE($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
- +4 SET FILE=""
- FOR OCXPTR=1:1:$LENGTH(OCXDDPTH,",")
- Begin DoDot:1
- +5 NEW OCXDD,D0,FILEID
- +6 SET FILEID=$PIECE(OCXDDPTH,",",OCXPTR)
- +7 IF (FILEID[":")
- Begin DoDot:2
- +8 SET D0=+$PIECE(FILEID,":",2)
- SET OCXDD=+$EXTRACT(FILEID,2,$LENGTH(FILEID))
- +9 WRITE !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)
- +10 if $LENGTH(FILE)
- SET FILE=FILE_","
- SET FILE=FILE_FILEID
- +11 IF $DATA(@("L("_FILE_",.01,""E"")"))
- WRITE ": ",@("L("_FILE_",.01,""E"")")
- if D0
- WRITE " [",D0,"]"
- +12 IF '$TEST
- IF $DATA(@("R("_FILE_",.01,""E"")"))
- WRITE ": ",@("R("_FILE_",.01,""E"")")
- if D0
- WRITE " [",D0,"]"
- End DoDot:2
- End DoDot:1
- +13 ;
- +14 QUIT
- +15 ;
- DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
- +1 ;
- +2 NEW OCXDPTR,LREF,RREF,OCXDDPTH
- +3 ;
- +4 SET OCXDDPTH=$PIECE($PIECE($$APPEND(CREF,OCXDD),"(",2),")",1)
- +5 SET LREF="L("_OCXDDPTH_")"
- SET RREF="R("_OCXDDPTH_")"
- +6 WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
- +7 IF OCXSUB
- WRITE " Line #",OCXSUB
- +8 ;
- +9 if ($DATA(@RREF@(OCXFLD,OCXSUB)))
- WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(R) OEX,OER: ",@RREF@(OCXFLD,OCXSUB)
- +10 if ($DATA(@LREF@(OCXFLD,OCXSUB)))
- WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)
- +11 ;
- +12 QUIT
- +13 ;
- +14 WRITE !,?10
- QUIT 0
- QUIT $$PAUSE
- +15 ;
- PAUSE() if 'OCXFLGC
- QUIT 0
- WRITE " Press Enter "
- READ X:DTIME
- WRITE !
- QUIT (X[U)
- +1 ;
- NOW() NEW X,Y,%DT
- SET X="N"
- SET %DT="T"
- DO ^%DT
- SET Y=$$DATE^OCXBDTD(Y)
- if (Y["@")
- SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
- QUIT Y
- +1 ;
