GMRCDPCK.m

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 ---GMRCDPCK   1671     printed  Apr 09, 2024@20:50:22                                                                                                                                                                                                    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