- GMRCADC ;SLC/DLT/DCM - DC taken from List Manager ; 7/11/05 1:40pm
- ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,12,35,39,47**;DEC 27, 1997
- EXAC(MSG) ;Exit message asking for user to press <ENTER> EXAC=Exit Action
- N ND,X
- W $C(7),!,MSG I $O(MSG(0)) S ND=0 F S ND=$O(MSG(ND)) Q:ND="" D
- . W !,MSG(ND)
- W !,"Press <RETURN> to continue: " R X:DTIME W !!
- Q
- DC(GMRCO,GMRCA) ;Discontinue a consult logic from DC^GMRCA1
- I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
- N GMRCDA,GMRCACTM,GMRCADUZ,GMRCSERV,GMRCAD,GMRC
- K GMRCQUT,GMRCQIT
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) Q
- I '+$G(GMRCO) S GMRCQUT=1 Q
- I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
- . N DIR
- . W !,"The requesting facility may not take this action on an "
- . W "inter-facility consult."
- . S DIR(0)="E" D ^DIR
- . S GMRCQUT=1
- I '$$LOCK^GMRCA1(GMRCO) S GMRCQUT=1 Q
- ;
- S GMRC(0)=^GMR(123,GMRCO,0),GMRCDA=GMRCO
- S (GMRCDFN,DFN)=$P(GMRC(0),"^",2)
- I $D(GMRCA),+GMRCA S GMRCACTM=$S(GMRCA=6:"Discontinued",GMRCA=19:"Cancelled",1:$P($G(^GMR(123.1,+GMRCA,0)),"^",1))
- ;
- D PROC I $D(GMRCQUT) D UNLOCK^GMRCA1(GMRCO) S GMRCQUT=1 Q
- ;send 513 back to service printer if request DC'd or Cancelled
- I GMRCA=6,$$DCPRNT^GMRCUTL1(+GMRCO,DUZ) D
- . D PRNT^GMRCUTL1(+$P(GMRC(0),U,5),+GMRCO)
- S GMRCTRLC=$S(GMRCA=19:"OC",1:"OD")
- D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),GMRCTRLC,GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
- D UNLOCK^GMRCA1(GMRCO)
- Q
- ;
- PROC ;Check validity of action and if valid process the discontinue action
- N DIROUT,DTOUT,DUOUT,GMRCMSG,GMRCFL,GMRCACT
- I $P(GMRC(0),"^",12)=1 S GMRCMSG="This consult has already been discontinued!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
- I $P(GMRC(0),"^",12)=2 S GMRCMSG="This consult has already been completed!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
- I $P(GMRC(0),"^",12)=9 S GMRCMSG="Action invalid. This consult has partial results!",GMRCMSG(1)="Remove the associated results and then discontinue." D EXAC(.GMRCMSG) S GMRCQUT=1 Q
- I $P(GMRC(0),"^",12)=13 S GMRCMSG="This consult has already been cancelled!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
- ;
- S GMRCORVP=GMRCDFN_";DPT("
- N GETPROV
- FRGTPRV D GETPROV^GMRCAU I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) S GMRCQUT=1 Q
- S GMRCACT=$$PROVIDER^XUSER(GMRCORNP) I $P(GMRCACT,U)'=1 D G FRGTPRV
- .W !!,"***User account is TERMINATED please choose another responsible user.***"
- S GMRCAD=$$GETDT^GMRCUTL1 ;Returns GMRCAD as the entered date
- I GMRCAD="^" S GMRCQUT=1 Q
- S GMRCSTS=$S(GMRCA=6:1,1:13),$P(GMRC(0),"^",12)=GMRCSTS
- S GMRCOM=1
- D STATUS^GMRCP
- D AUDIT^GMRCP
- ;
- S GMRCORTX=$S($L($G(GMRCACTM)):GMRCACTM,+GMRCA:$P(^GMR(123.1,GMRCA,0),U,1),1:"ACTION UNKNOWN FOR")_" consult "_$$ORTX^GMRCAU(+GMRCO)
- S GMRCADUZ="",GMRCFL=0
- I +$P($G(^GMR(123,+GMRCO,0)),"^",14),+$P(^(0),"^",14)'=DUZ S GMRCADUZ($P(^(0),"^",14))=""
- ;I +$P($G(^GMR(123,+GMRCO,0)),"^",14)=DUZ S GMRCFL=1
- I GMRCA=6 S GMRCFL=$$DCNOTE(GMRCO,DUZ) ;check NOTIFY SERVICE ON DC
- ;I GMRCA=19 S GMRCFL=1
- ;send notification info to routine to be sent to OERR
- N NOTYPE S NOTYPE=$S(GMRCA=6:23,1:30)
- D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,NOTYPE,.GMRCADUZ,GMRCFL)
- Q
- DCNOTE(IEN,USER) ;determine if service users receive alerts based on 1.04
- N SERV,DCFLG
- S SERV=$P(^GMR(123,IEN,0),U,5)
- S DCFLG=$P($G(^GMR(123.5,SERV,1)),U,4)
- I 'DCFLG Q 1
- I DCFLG=2 Q 0
- I DCFLG=1,'$$VALID^GMRCAU(SERV,IEN,USER) Q 1
- Q 0
- GMRCADC ;SLC/DLT/DCM - DC taken from List Manager ; 7/11/05 1:40pm
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,12,35,39,47**;DEC 27, 1997
- EXAC(MSG) ;Exit message asking for user to press <ENTER> EXAC=Exit Action
- +1 NEW ND,X
- +2 WRITE $CHAR(7),!,MSG
- IF $ORDER(MSG(0))
- SET ND=0
- FOR
- SET ND=$ORDER(MSG(ND))
- IF ND=""
- QUIT
- Begin DoDot:1
- +3 WRITE !,MSG(ND)
- End DoDot:1
- +4 WRITE !,"Press <RETURN> to continue: "
- READ X:DTIME
- WRITE !!
- +5 QUIT
- DC(GMRCO,GMRCA) ;Discontinue a consult logic from DC^GMRCA1
- +1 IF $DATA(IOTM)
- IF $DATA(IOBM)
- IF $DATA(IOSTBM)
- DO FULL^VALM1
- +2 NEW GMRCDA,GMRCACTM,GMRCADUZ,GMRCSERV,GMRCAD,GMRC
- +3 KILL GMRCQUT,GMRCQIT
- +4 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- QUIT
- +5 IF '+$GET(GMRCO)
- SET GMRCQUT=1
- QUIT
- +6 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
- Begin DoDot:1
- +7 NEW DIR
- +8 WRITE !,"The requesting facility may not take this action on an "
- +9 WRITE "inter-facility consult."
- +10 SET DIR(0)="E"
- DO ^DIR
- +11 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +12 IF '$$LOCK^GMRCA1(GMRCO)
- SET GMRCQUT=1
- QUIT
- +13 ;
- +14 SET GMRC(0)=^GMR(123,GMRCO,0)
- SET GMRCDA=GMRCO
- +15 SET (GMRCDFN,DFN)=$PIECE(GMRC(0),"^",2)
- +16 IF $DATA(GMRCA)
- IF +GMRCA
- SET GMRCACTM=$SELECT(GMRCA=6:"Discontinued",GMRCA=19:"Cancelled",1:$PIECE($GET(^GMR(123.1,+GMRCA,0)),"^",1))
- +17 ;
- +18 DO PROC
- IF $DATA(GMRCQUT)
- DO UNLOCK^GMRCA1(GMRCO)
- SET GMRCQUT=1
- QUIT
- +19 ;send 513 back to service printer if request DC'd or Cancelled
- +20 IF GMRCA=6
- IF $$DCPRNT^GMRCUTL1(+GMRCO,DUZ)
- Begin DoDot:1
- +21 DO PRNT^GMRCUTL1(+$PIECE(GMRC(0),U,5),+GMRCO)
- End DoDot:1
- +22 SET GMRCTRLC=$SELECT(GMRCA=19:"OC",1:"OD")
- +23 DO EN^GMRCHL7(DFN,GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),GMRCTRLC,GMRCORNP,$GET(GMRCVSIT),.GMRCOM,,$GET(GMRCAD))
- +24 DO UNLOCK^GMRCA1(GMRCO)
- +25 QUIT
- +26 ;
- PROC ;Check validity of action and if valid process the discontinue action
- +1 NEW DIROUT,DTOUT,DUOUT,GMRCMSG,GMRCFL,GMRCACT
- +2 IF $PIECE(GMRC(0),"^",12)=1
- SET GMRCMSG="This consult has already been discontinued!"
- DO EXAC(GMRCMSG)
- SET GMRCQUT=1
- QUIT
- +3 IF $PIECE(GMRC(0),"^",12)=2
- SET GMRCMSG="This consult has already been completed!"
- DO EXAC(GMRCMSG)
- SET GMRCQUT=1
- QUIT
- +4 IF $PIECE(GMRC(0),"^",12)=9
- SET GMRCMSG="Action invalid. This consult has partial results!"
- SET GMRCMSG(1)="Remove the associated results and then discontinue."
- DO EXAC(.GMRCMSG)
- SET GMRCQUT=1
- QUIT
- +5 IF $PIECE(GMRC(0),"^",12)=13
- SET GMRCMSG="This consult has already been cancelled!"
- DO EXAC(GMRCMSG)
- SET GMRCQUT=1
- QUIT
- +6 ;
- +7 SET GMRCORVP=GMRCDFN_";DPT("
- +8 NEW GETPROV
- FRGTPRV DO GETPROV^GMRCAU
- IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
- SET GMRCQUT=1
- QUIT
- +1 SET GMRCACT=$$PROVIDER^XUSER(GMRCORNP)
- IF $PIECE(GMRCACT,U)'=1
- Begin DoDot:1
- +2 WRITE !!,"***User account is TERMINATED please choose another responsible user.***"
- End DoDot:1
- GOTO FRGTPRV
- +3 ;Returns GMRCAD as the entered date
- SET GMRCAD=$$GETDT^GMRCUTL1
- +4 IF GMRCAD="^"
- SET GMRCQUT=1
- QUIT
- +5 SET GMRCSTS=$SELECT(GMRCA=6:1,1:13)
- SET $PIECE(GMRC(0),"^",12)=GMRCSTS
- +6 SET GMRCOM=1
- +7 DO STATUS^GMRCP
- +8 DO AUDIT^GMRCP
- +9 ;
- +10 SET GMRCORTX=$SELECT($LENGTH($GET(GMRCACTM)):GMRCACTM,+GMRCA:$PIECE(^GMR(123.1,GMRCA,0),U,1),1:"ACTION UNKNOWN FOR")_" consult "_$$ORTX^GMRCAU(+GMRCO)
- +11 SET GMRCADUZ=""
- SET GMRCFL=0
- +12 IF +$PIECE($GET(^GMR(123,+GMRCO,0)),"^",14)
- IF +$PIECE(^(0),"^",14)'=DUZ
- SET GMRCADUZ($PIECE(^(0),"^",14))=""
- +13 ;I +$P($G(^GMR(123,+GMRCO,0)),"^",14)=DUZ S GMRCFL=1
- +14 ;check NOTIFY SERVICE ON DC
- IF GMRCA=6
- SET GMRCFL=$$DCNOTE(GMRCO,DUZ)
- +15 ;I GMRCA=19 S GMRCFL=1
- +16 ;send notification info to routine to be sent to OERR
- +17 NEW NOTYPE
- SET NOTYPE=$SELECT(GMRCA=6:23,1:30)
- +18 DO MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,NOTYPE,.GMRCADUZ,GMRCFL)
- +19 QUIT
- DCNOTE(IEN,USER) ;determine if service users receive alerts based on 1.04
- +1 NEW SERV,DCFLG
- +2 SET SERV=$PIECE(^GMR(123,IEN,0),U,5)
- +3 SET DCFLG=$PIECE($GET(^GMR(123.5,SERV,1)),U,4)
- +4 IF 'DCFLG
- QUIT 1
- +5 IF DCFLG=2
- QUIT 0
- +6 IF DCFLG=1
- IF '$$VALID^GMRCAU(SERV,IEN,USER)
- QUIT 1
- +7 QUIT 0
