- OCXGENE ;SLC/RJS,CLA - External Interface - PROCESS GENERIC RESULT REQUESTS;3/1/99 12:37
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- ;
- Q
- EN(OUTMSG,OCXDFN,OCXGND,OCXGNM) ;
- ;
- N OCXRDT,OCXOZZT
- S OCXRDT=($H*86400+$P($H,",",2))
- S:'$D(OUTMSG) OUTMSG=""
- D CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
- Q
- VERBOSE(OCXGND,OCXGNM,OCXDFN) ;
- ;
- N OCXX,OUTMSG,OCXOZZT
- S OCXRDT=($H*86400+$P($H,",",2))
- S OUTMSG=""
- D CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
- W:$O(OUTMSG(0)) !,"Generic Query Results: ",$C(7)
- S OCXX=0 F S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX W !,OUTMSG(OCXX)
- W:$O(OUTMSG(0)) !,$C(7)
- Q
- ;
- CHECK(OCXGND,OCXGNM,OCXDFN,OUTMSG) ;
- ;
- ;
- I $$RTEST D Q
- .N OMSG,OTMOUT,OCXM
- .S OMSG="^25^^Order Checking is recompiling and momentarily disabled"
- .S OCXM=0 F S OCXM=$O(OUTMSG(OCXM)) Q:'OCXM Q:(OUTMSG(OCXM)[OMSG)
- .Q:OCXM
- .S OUTMSG($O(OUTMSG(""),-1)+1)=OMSG
- ;
- ;
- N OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y
- N OCXOLOG,OCXORDT,OCXOSRC
- ;
- S DFN=+OCXDFN
- S X="N",%DT="T" D ^%DT S OCXORDT=+Y
- Q:'DFN
- ;
- S (OCXTEST,OCXDATA)=""
- S OCXOSRC="GENERIC QUERY"
- ;
- S OCXOLOG=$$LOG(OCXGND,OCXGNM)
- ;
- D UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)
- ;
- D FINISH^OCXOLOG(OCXOLOG)
- ;
- Q
- ;
- ;
- RTEST() ;
- N DATE,TMOUT
- Q:'$L($T(^OCXOZ01)) 1
- I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
- S DATE=$P($G(^OCXD(861,1,0)),U,3)
- I DATE,((+DATE)=(+$H)),(((+$P($H,",",2))-(+$P(DATE,",",2)))<1800) Q 1
- Q 0
- ;
- LOG(OCXGND,OCXGNM) ;
- ;
- ; Log Messages
- ;
- I $G(OCXTRACE),$$CDATA^OCXOZ01 Q 0
- Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0
- N OCXNL
- S OCXARY="OCXNL"
- S OCXNL(1)="OCXGND="_OCXGND
- S OCXNL(2)="OCXGNM="_OCXGNM
- Q $$NEW^OCXOLOG(OCXARY,"QUERY",+$G(DUZ),+OCXDFN)
- ;
- ERROR Q
- ;
- ;
- ; **** Old Labels to insure backwards compatibility ****
- ;
- PROC(OCXORD) ;
- D VERBOSE(OCXORD) Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXGENE 1971 printed Jan 18, 2025@03:25:46 Page 2
- OCXGENE ;SLC/RJS,CLA - External Interface - PROCESS GENERIC RESULT REQUESTS;3/1/99 12:37
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
- +2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- +3 ;
- +4 ;
- +5 QUIT
- EN(OUTMSG,OCXDFN,OCXGND,OCXGNM) ;
- +1 ;
- +2 NEW OCXRDT,OCXOZZT
- +3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
- +4 if '$DATA(OUTMSG)
- SET OUTMSG=""
- +5 DO CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
- +6 QUIT
- VERBOSE(OCXGND,OCXGNM,OCXDFN) ;
- +1 ;
- +2 NEW OCXX,OUTMSG,OCXOZZT
- +3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
- +4 SET OUTMSG=""
- +5 DO CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
- +6 if $ORDER(OUTMSG(0))
- WRITE !,"Generic Query Results: ",$CHAR(7)
- +7 SET OCXX=0
- FOR
- SET OCXX=$ORDER(OUTMSG(OCXX))
- if 'OCXX
- QUIT
- WRITE !,OUTMSG(OCXX)
- +8 if $ORDER(OUTMSG(0))
- WRITE !,$CHAR(7)
- +9 QUIT
- +10 ;
- CHECK(OCXGND,OCXGNM,OCXDFN,OUTMSG) ;
- +1 ;
- +2 ;
- +3 IF $$RTEST
- Begin DoDot:1
- +4 NEW OMSG,OTMOUT,OCXM
- +5 SET OMSG="^25^^Order Checking is recompiling and momentarily disabled"
- +6 SET OCXM=0
- FOR
- SET OCXM=$ORDER(OUTMSG(OCXM))
- if 'OCXM
- QUIT
- if (OUTMSG(OCXM)[OMSG)
- QUIT
- +7 if OCXM
- QUIT
- +8 SET OUTMSG($ORDER(OUTMSG(""),-1)+1)=OMSG
- End DoDot:1
- QUIT
- +9 ;
- +10 ;
- +11 NEW OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y
- +12 NEW OCXOLOG,OCXORDT,OCXOSRC
- +13 ;
- +14 SET DFN=+OCXDFN
- +15 SET X="N"
- SET %DT="T"
- DO ^%DT
- SET OCXORDT=+Y
- +16 if 'DFN
- QUIT
- +17 ;
- +18 SET (OCXTEST,OCXDATA)=""
- +19 SET OCXOSRC="GENERIC QUERY"
- +20 ;
- +21 SET OCXOLOG=$$LOG(OCXGND,OCXGNM)
- +22 ;
- +23 DO UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)
- +24 ;
- +25 DO FINISH^OCXOLOG(OCXOLOG)
- +26 ;
- +27 QUIT
- +28 ;
- +29 ;
- RTEST() ;
- +1 NEW DATE,TMOUT
- +2 if '$LENGTH($TEXT(^OCXOZ01))
- QUIT 1
- +3 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
- KILL ^OCXD(861,1)
- SET ^OCXD(861,1,0)="SITE PREFERENCES"
- +4 SET DATE=$PIECE($GET(^OCXD(861,1,0)),U,3)
- +5 IF DATE
- IF ((+DATE)=(+$HOROLOG))
- IF (((+$PIECE($HOROLOG,",",2))-(+$PIECE(DATE,",",2)))<1800)
- QUIT 1
- +6 QUIT 0
- +7 ;
- LOG(OCXGND,OCXGNM) ;
- +1 ;
- +2 ; Log Messages
- +3 ;
- +4 IF $GET(OCXTRACE)
- IF $$CDATA^OCXOZ01
- QUIT 0
- +5 if '$LENGTH($TEXT(LOG^OCXOZ01))
- QUIT 0
- if '$$LOG^OCXOZ01
- QUIT 0
- +6 NEW OCXNL
- +7 SET OCXARY="OCXNL"
- +8 SET OCXNL(1)="OCXGND="_OCXGND
- +9 SET OCXNL(2)="OCXGNM="_OCXGNM
- +10 QUIT $$NEW^OCXOLOG(OCXARY,"QUERY",+$GET(DUZ),+OCXDFN)
- +11 ;
- ERROR QUIT
- +1 ;
- +2 ;
- +3 ; **** Old Labels to insure backwards compatibility ****
- +4 ;
- PROC(OCXORD) ;
- +1 DO VERBOSE(OCXORD)
- QUIT
- +2 ;