- GMRCDPCK ;SLC/DCM - Check for a duplicate Consult/Request that has a status of active, pending or scheduled ;5/20/98 14:20
- ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- EN(PTN,GMRCPRC,GMRCSVC) ;Main entry point
- ;PTN=DFN, Patient IEN from ^DPT(
- ;GMRCPRC=PROCEDURE, FROM PROTOCOL FILE - ^ORD(101,GMRCPRC
- ;GMRCSVC=Service Name - i.e., 'MEDICINE' (this is not the IEN from file 123.5.
- Q:GMRCSVC=""
- K GMRCQUT N STS
- S GMRCTO=$O(^GMR(123.5,"B",GMRCSVC,0)),GMRCDUP=0
- S X1=DT,X2=-365 D C^%DTC S GMRCMDT=9999999-X ;Only look back 12 months for duplicates
- F STS=5,6,8 S GMRCDATE=0 D
- .F S GMRCDATE=$O(^GMR(123,"AE",GMRCTO,STS,GMRCDATE)) Q:GMRCDATE>GMRCMDT!(GMRCDATE="") S GMRCIEN=$O(^GMR(123,"AE",GMRCTO,STS,GMRCDATE,0)),GMRC(0)=^GMR(123,GMRCIEN,0) D
- ..I $P(GMRC(0),"^",2)=PTN,$P(GMRC(0),"^",8)=GMRCPRC S Y=9999999-GMRCDATE X ^DD("DD") S GMRCDUP=GMRCDUP+1 D
- ...W $C(7),!!,"A"_$S(GMRCDUP>1:"n Other",1:"")_" Consult/Request Order For an ",$S($D(^ORD(101,+GMRCPRI,.1)):^(.1),GMRCPR]"":GMRCPR,1:"")," Exists.",!!?10,"Date Ordered: ",$P(Y,"@",1),$S($P(Y,"@",2):" At "_$P(Y,"@",2),1:"")
- ...W !?10,"Current Status: ",$S(STS=5:"Pending",STS=6:"Active",STS=8:"Scheduled: ",1:"No Status")
- ...W !?10,"Ordering Provider: ",$S($P(GMRC(0),"^",14)]"":$P(^VA(200,$P(GMRC(0),"^",14),0),"^",1),1:"Unknown")
- ...S GMRC(0)=""
- ...Q
- ..Q
- .Q
- I GMRCDUP>1 W !!,"Multiple Orders ("_GMRCDUP_") For a/an "_$S($D(^ORD(101,+GMRCPRI,.1)):^(.1),GMRCPR]"":GMRCPR,1:"")_" Exist."
- I GMRCDUP W !!,"Do You Want To Continue - And Complete - This Order Anyway? N// " R Y:DTIME I $S(Y="":1,Y["N":1,Y["n":1,1:0) S GMRCQUT=1
- K GMRC(0),GMRCDATE,GMRCDUP,GMRCIEN,GMRCMDT,GMRCTO
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCDPCK 1671 printed Jan 18, 2025@02:46:42 Page 2
- GMRCDPCK ;SLC/DCM - Check for a duplicate Consult/Request that has a status of active, pending or scheduled ;5/20/98 14:20
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- EN(PTN,GMRCPRC,GMRCSVC) ;Main entry point
- +1 ;PTN=DFN, Patient IEN from ^DPT(
- +2 ;GMRCPRC=PROCEDURE, FROM PROTOCOL FILE - ^ORD(101,GMRCPRC
- +3 ;GMRCSVC=Service Name - i.e., 'MEDICINE' (this is not the IEN from file 123.5.
- +4 if GMRCSVC=""
- QUIT
- +5 KILL GMRCQUT
- NEW STS
- +6 SET GMRCTO=$ORDER(^GMR(123.5,"B",GMRCSVC,0))
- SET GMRCDUP=0
- +7 ;Only look back 12 months for duplicates
- SET X1=DT
- SET X2=-365
- DO C^%DTC
- SET GMRCMDT=9999999-X
- +8 FOR STS=5,6,8
- SET GMRCDATE=0
- Begin DoDot:1
- +9 FOR
- SET GMRCDATE=$ORDER(^GMR(123,"AE",GMRCTO,STS,GMRCDATE))
- if GMRCDATE>GMRCMDT!(GMRCDATE="")
- QUIT
- SET GMRCIEN=$ORDER(^GMR(123,"AE",GMRCTO,STS,GMRCDATE,0))
- SET GMRC(0)=^GMR(123,GMRCIEN,0)
- Begin DoDot:2
- +10 IF $PIECE(GMRC(0),"^",2)=PTN
- IF $PIECE(GMRC(0),"^",8)=GMRCPRC
- SET Y=9999999-GMRCDATE
- XECUTE ^DD("DD")
- SET GMRCDUP=GMRCDUP+1
- Begin DoDot:3
- +11 WRITE $CHAR(7),!!,"A"_$SELECT(GMRCDUP>1:"n Other",1:"")_" Consult/Request Order For an ",$SELECT($DATA(^ORD(101,+GMRCPRI,.1)):^(.1),GMRCPR]"":GMRCPR,1:"")," Exists.",!!?10,"Date Ordered: ",$PIECE(Y,"@",1),$SELECT($PIE
- CE(Y,"@",2):" At "_...
- ... $PIECE(Y,"@",2),1:"")
- +12 WRITE !?10,"Current Status: ",$SELECT(STS=5:"Pending",STS=6:"Active",STS=8:"Scheduled: ",1:"No Status")
- +13 WRITE !?10,"Ordering Provider: ",$SELECT($PIECE(GMRC(0),"^",14)]"":$PIECE(^VA(200,$PIECE(GMRC(0),"^",14),0),"^",1),1:"Unknown")
- +14 SET GMRC(0)=""
- +15 QUIT
- End DoDot:3
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 IF GMRCDUP>1
- WRITE !!,"Multiple Orders ("_GMRCDUP_") For a/an "_$SELECT($DATA(^ORD(101,+GMRCPRI,.1)):^(.1),GMRCPR]"":GMRCPR,1:"")_" Exist."
- +19 IF GMRCDUP
- WRITE !!,"Do You Want To Continue - And Complete - This Order Anyway? N// "
- READ Y:DTIME
- IF $SELECT(Y="":1,Y["N":1,Y["n":1,1:0)
- SET GMRCQUT=1
- +20 KILL GMRC(0),GMRCDATE,GMRCDUP,GMRCIEN,GMRCMDT,GMRCTO