- OCXODGPM ;SLC/RJS,CLA - External Interface - PROCESS MAS MOVEMENT EVENT ;4/30/99 15:03
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- ;
- Q
- SILENT(OUTMSG) ;
- ;
- N OCXRDT,OCXOZZT
- S OCXRDT=($H*86400+$P($H,",",2))
- S:'$D(OUTMSG) OUTMSG=""
- D CHECK(.OUTMSG)
- Q
- VERBOSE ;
- ;
- N OCXX,OUTMSG,OCXOZZT
- S OCXRDT=($H*86400+$P($H,",",2))
- S OUTMSG=""
- D CHECK(.OUTMSG)
- W:$O(OUTMSG(0)) !,"Order Check Message: ",$C(7)
- S OCXX=0 F S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX W !,OUTMSG(OCXX)
- W:$O(OUTMSG(0)) !,$C(7)
- Q
- ;
- CHECK(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,OCXOLOG,OCXOSRC
- ;
- S (OCXTEST,OCXDATA)=""
- S OCXOSRC="DGPM PATIENT MOVEMENT PROTOCOL"
- ;
- S OCXOLOG=$$LOG($G(DGPMDA),$G(DGPM0),$G(DGPMA),$G(DGPMP))
- ;
- D UPDATE^OCXOZ01(+$G(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(OCXD1,OCXD2,OCXD3,OCXD4) ;
- ;
- ; Log Messages
- ;
- I $G(OCXTRACE),$$CDATA^OCXOZ01 D Q 0
- .W !," Raw Input Data "
- .W !," DFN: ",$G(DFN)
- .W !," DGPMDA: ",$G(DGPMDA)
- .W !," DGPMA: ",$G(DGPMA)
- .W !," DGPM0: ",$G(DGPM0)
- .W !," DGPMP: ",$G(DGPMP)
- .W !
- ;
- Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0
- N OCXNL
- S OCXARY="OCXNL"
- S OCXNL(1)="DGPMDA="_$G(OCXD1)
- S OCXNL(2)="DGPM0="_$G(OCXD2)
- S OCXNL(3)="DGPMA="_$G(OCXD3)
- S OCXNL(4)="DGPMP="_$G(OCXD4)
- Q $$NEW^OCXOLOG(OCXARY,"DGPM",+$G(DUZ),+$G(DFN))
- ;
- ERROR Q
- ;
- ; **** Old Labels to insure backwards compatibility ****
- ;
- PROC(OUTMSG) ;
- D SILENT(.OUTMSG)
- Q
- ;
- EN D VERBOSE Q
- ;
- NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT Q +Y
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXODGPM 2146 printed Jan 18, 2025@03:26:20 Page 2
- OCXODGPM ;SLC/RJS,CLA - External Interface - PROCESS MAS MOVEMENT EVENT ;4/30/99 15:03
- +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
- SILENT(OUTMSG) ;
- +1 ;
- +2 NEW OCXRDT,OCXOZZT
- +3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
- +4 if '$DATA(OUTMSG)
- SET OUTMSG=""
- +5 DO CHECK(.OUTMSG)
- +6 QUIT
- VERBOSE ;
- +1 ;
- +2 NEW OCXX,OUTMSG,OCXOZZT
- +3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
- +4 SET OUTMSG=""
- +5 DO CHECK(.OUTMSG)
- +6 if $ORDER(OUTMSG(0))
- WRITE !,"Order Check Message: ",$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(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 NEW OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,OCXOLOG,OCXOSRC
- +11 ;
- +12 SET (OCXTEST,OCXDATA)=""
- +13 SET OCXOSRC="DGPM PATIENT MOVEMENT PROTOCOL"
- +14 ;
- +15 SET OCXOLOG=$$LOG($GET(DGPMDA),$GET(DGPM0),$GET(DGPMA),$GET(DGPMP))
- +16 ;
- +17 DO UPDATE^OCXOZ01(+$GET(DFN),OCXOSRC,.OUTMSG)
- +18 ;
- +19 DO FINISH^OCXOLOG(OCXOLOG)
- +20 ;
- +21 QUIT
- +22 ;
- 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(OCXD1,OCXD2,OCXD3,OCXD4) ;
- +1 ;
- +2 ; Log Messages
- +3 ;
- +4 IF $GET(OCXTRACE)
- IF $$CDATA^OCXOZ01
- Begin DoDot:1
- +5 WRITE !," Raw Input Data "
- +6 WRITE !," DFN: ",$GET(DFN)
- +7 WRITE !," DGPMDA: ",$GET(DGPMDA)
- +8 WRITE !," DGPMA: ",$GET(DGPMA)
- +9 WRITE !," DGPM0: ",$GET(DGPM0)
- +10 WRITE !," DGPMP: ",$GET(DGPMP)
- +11 WRITE !
- End DoDot:1
- QUIT 0
- +12 ;
- +13 if '$LENGTH($TEXT(LOG^OCXOZ01))
- QUIT 0
- if '$$LOG^OCXOZ01
- QUIT 0
- +14 NEW OCXNL
- +15 SET OCXARY="OCXNL"
- +16 SET OCXNL(1)="DGPMDA="_$GET(OCXD1)
- +17 SET OCXNL(2)="DGPM0="_$GET(OCXD2)
- +18 SET OCXNL(3)="DGPMA="_$GET(OCXD3)
- +19 SET OCXNL(4)="DGPMP="_$GET(OCXD4)
- +20 QUIT $$NEW^OCXOLOG(OCXARY,"DGPM",+$GET(DUZ),+$GET(DFN))
- +21 ;
- ERROR QUIT
- +1 ;
- +2 ; **** Old Labels to insure backwards compatibility ****
- +3 ;
- PROC(OUTMSG) ;
- +1 DO SILENT(.OUTMSG)
- +2 QUIT
- +3 ;
- EN DO VERBOSE
- QUIT
- +1 ;
- NOW() NEW X,Y,%DT
- SET X="N"
- SET %DT="T"
- DO ^%DT
- QUIT +Y
- +1 ;