- OCXOSCR1 ;SLC/RJS,CLA - Post selection action for the Order Check DataField File;6/19/01 16:35
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- I $G(OCXSCR) K OCXSCR Q
- ;
- Q
- ;
- S ;
- ;
- N OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXDF,OCXHDR
- ;
- W ! D WAIT^DICD W ! S OCXHDR="This Datafield is used by: "
- I $D(^OCXS(860.4,+Y)) M OCXDF=^OCXS(860.4,+Y)
- E Q
- ;
- S OCXD0=0 F S OCXD0=$O(^OCXS(860.3,OCXD0)) Q:'OCXD0 D
- .K OCXREC M OCXREC=^OCXS(860.3,OCXD0)
- .K OCXDISP S OCXDISP(1)="** Element: "_$P(OCXREC(0),U,1)
- .S OCXD1=0 F S OCXD1=$O(OCXREC("COND",OCXD1)) Q:'OCXD1 D
- ..S OCXDISP(2)=" Expression Number: "_+OCXREC("COND",OCXD1,0)
- ..I ($G(OCXREC("COND",OCXD1,"DFLD1"))=+Y) S OCXDISP(2)=" Primary Data Field 2" D DISPLAY
- ..I ($G(OCXREC("COND",OCXD1,"DFLD2"))=+Y) S OCXDISP(2)=" Data Field 2" D DISPLAY
- ..I ($G(OCXREC("COND",OCXD1,"DFLD3"))=+Y) S OCXDISP(2)=" Data Field 3" D DISPLAY
- ;
- S OCXNAME=$P($G(OCXDF(0)),U,1),OCXABBR=$P($G(OCXDF(1)),U,1)
- ;
- W ! S OCXD0=0 F S OCXD0=$O(^OCXS(860.2,OCXD0)) Q:'OCXD0 D
- .K OCXREC M OCXREC=^OCXS(860.2,OCXD0)
- .K OCXDISP S OCXDISP(1)="** Rule: "_$P(OCXREC(0),U,1)
- .S OCXD1=0 F S OCXD1=$O(OCXREC("C",OCXD1)) Q:'OCXD1 D
- ..S OCXDISP(2)=" Condition: "_$P(OCXREC("C",OCXD1,0),U,1)
- ..S OCXVAL=$G(OCXREC("C",OCXD1,"EXP"))
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
- .S OCXD1=0 F S OCXD1=$O(OCXREC("R",OCXD1)) Q:'OCXD1 D
- ..S OCXDISP(2)=" Relation Index: "_$P(OCXREC("R",OCXD1,0),U,1)
- ..;
- ..S OCXVAL=$G(OCXREC("R",OCXD1,"E"))
- ..S OCXDISP(2)=" Expression field"
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
- ..;
- ..S OCXVAL=$G(OCXREC("R",OCXD1,"MSG"))
- ..S OCXDISP(2)=" Notification Message field"
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
- ..;
- ..S OCXVAL=$G(OCXREC("R",OCXD1,"OCMSG"))
- ..S OCXDISP(2)=" Order Check Message field"
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
- ..;
- ..S OCXVAL=$G(OCXREC("R",OCXD1,"MCODE"))
- ..S OCXDISP(2)=" Execute code field"
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
- ..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
- W !
- ;
- SELECT ;
- ;
- N DIC,X,Y
- ;
- F S DIC=860.4,DIC(0)="AEMQN" D ^DIC Q:(Y<1) I (Y>0) D S
- ;
- Q
- ;
- DISPLAY ;
- ;
- N OCXX
- W !
- I $L(OCXHDR) W !,OCXHDR,! S OCXHDR=""
- S OCXX=0 F S OCXX=$O(OCXDISP(OCXX)) Q:'OCXX W OCXDISP(OCXX)
- Q
- ;
- OCXOSCR1 ;SLC/RJS,CLA - Post selection action for the Order Check DataField File;6/19/01 16:35
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
- +2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- +3 ;
- +4 IF $GET(OCXSCR)
- KILL OCXSCR
- QUIT
- +5 ;
- +6 QUIT
- +7 ;
- S ;
- +1 ;
- +2 NEW OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXDF,OCXHDR
- +3 ;
- +4 WRITE !
- DO WAIT^DICD
- WRITE !
- SET OCXHDR="This Datafield is used by: "
- +5 IF $DATA(^OCXS(860.4,+Y))
- MERGE OCXDF=^OCXS(860.4,+Y)
- +6 IF '$TEST
- QUIT
- +7 ;
- +8 SET OCXD0=0
- FOR
- SET OCXD0=$ORDER(^OCXS(860.3,OCXD0))
- IF 'OCXD0
- QUIT
- Begin DoDot:1
- +9 KILL OCXREC
- MERGE OCXREC=^OCXS(860.3,OCXD0)
- +10 KILL OCXDISP
- SET OCXDISP(1)="** Element: "_$PIECE(OCXREC(0),U,1)
- +11 SET OCXD1=0
- FOR
- SET OCXD1=$ORDER(OCXREC("COND",OCXD1))
- IF 'OCXD1
- QUIT
- Begin DoDot:2
- +12 SET OCXDISP(2)=" Expression Number: "_+OCXREC("COND",OCXD1,0)
- +13 IF ($GET(OCXREC("COND",OCXD1,"DFLD1"))=+Y)
- SET OCXDISP(2)=" Primary Data Field 2"
- DO DISPLAY
- +14 IF ($GET(OCXREC("COND",OCXD1,"DFLD2"))=+Y)
- SET OCXDISP(2)=" Data Field 2"
- DO DISPLAY
- +15 IF ($GET(OCXREC("COND",OCXD1,"DFLD3"))=+Y)
- SET OCXDISP(2)=" Data Field 3"
- DO DISPLAY
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 SET OCXNAME=$PIECE($GET(OCXDF(0)),U,1)
- SET OCXABBR=$PIECE($GET(OCXDF(1)),U,1)
- +18 ;
- +19 WRITE !
- SET OCXD0=0
- FOR
- SET OCXD0=$ORDER(^OCXS(860.2,OCXD0))
- IF 'OCXD0
- QUIT
- Begin DoDot:1
- +20 KILL OCXREC
- MERGE OCXREC=^OCXS(860.2,OCXD0)
- +21 KILL OCXDISP
- SET OCXDISP(1)="** Rule: "_$PIECE(OCXREC(0),U,1)
- +22 SET OCXD1=0
- FOR
- SET OCXD1=$ORDER(OCXREC("C",OCXD1))
- IF 'OCXD1
- QUIT
- Begin DoDot:2
- +23 SET OCXDISP(2)=" Condition: "_$PIECE(OCXREC("C",OCXD1,0),U,1)
- +24 SET OCXVAL=$GET(OCXREC("C",OCXD1,"EXP"))
- +25 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXNAME_"|"))
- DO DISPLAY
- +26 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXABBR_"|"))
- DO DISPLAY
- +27 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXNAME_"|"))
- DO DISPLAY
- +28 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXABBR_"|"))
- DO DISPLAY
- End DoDot:2
- +29 SET OCXD1=0
- FOR
- SET OCXD1=$ORDER(OCXREC("R",OCXD1))
- IF 'OCXD1
- QUIT
- Begin DoDot:2
- +30 SET OCXDISP(2)=" Relation Index: "_$PIECE(OCXREC("R",OCXD1,0),U,1)
- +31 ;
- +32 SET OCXVAL=$GET(OCXREC("R",OCXD1,"E"))
- +33 SET OCXDISP(2)=" Expression field"
- +34 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXNAME_"|"))
- DO DISPLAY
- +35 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXABBR_"|"))
- DO DISPLAY
- +36 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXNAME_"|"))
- DO DISPLAY
- +37 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXABBR_"|"))
- DO DISPLAY
- +38 ;
- +39 SET OCXVAL=$GET(OCXREC("R",OCXD1,"MSG"))
- +40 SET OCXDISP(2)=" Notification Message field"
- +41 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXNAME_"|"))
- DO DISPLAY
- +42 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXABBR_"|"))
- DO DISPLAY
- +43 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXNAME_"|"))
- DO DISPLAY
- +44 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXABBR_"|"))
- DO DISPLAY
- +45 ;
- +46 SET OCXVAL=$GET(OCXREC("R",OCXD1,"OCMSG"))
- +47 SET OCXDISP(2)=" Order Check Message field"
- +48 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXNAME_"|"))
- DO DISPLAY
- +49 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXABBR_"|"))
- DO DISPLAY
- +50 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXNAME_"|"))
- DO DISPLAY
- +51 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXABBR_"|"))
- DO DISPLAY
- +52 ;
- +53 SET OCXVAL=$GET(OCXREC("R",OCXD1,"MCODE"))
- +54 SET OCXDISP(2)=" Execute code field"
- +55 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXNAME_"|"))
- DO DISPLAY
- +56 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("|"_OCXABBR_"|"))
- DO DISPLAY
- +57 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXNAME_"|"))
- DO DISPLAY
- +58 IF $LENGTH(OCXVAL)
- IF (OCXVAL[("."_OCXABBR_"|"))
- DO DISPLAY
- End DoDot:2
- End DoDot:1
- +59 WRITE !
- +60 ;
- SELECT ;
- +1 ;
- +2 NEW DIC,X,Y
- +3 ;
- +4 FOR
- SET DIC=860.4
- SET DIC(0)="AEMQN"
- DO ^DIC
- IF (Y<1)
- QUIT
- IF (Y>0)
- DO S
- +5 ;
- +6 QUIT
- +7 ;
- DISPLAY ;
- +1 ;
- +2 NEW OCXX
- +3 WRITE !
- +4 IF $LENGTH(OCXHDR)
- WRITE !,OCXHDR,!
- SET OCXHDR=""
- +5 SET OCXX=0
- FOR
- SET OCXX=$ORDER(OCXDISP(OCXX))
- IF 'OCXX
- QUIT
- WRITE OCXDISP(OCXX)
- +6 QUIT
- +7 ;
