GMRCILKP ;SLC/JFR - LOOK UP IFC BY REMOTE CONS #; 1/2/02 14:34
;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
EN ; start here
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,GMRCSIT,GMRCO,DFN,GMRCREMC
N VALMBCK,VALMCNT,GMRCA,GMRCDIF,GMRCDVL,GMRCLOC,GMRCWARD,GMRCX,GMRCDISP
S DIR(0)="PO^4:EMQ"
S DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
S DIR("A")="Choose the facility to which the remote entry belongs"
D ^DIR
I $D(DIRUT) Q
S GMRCSIT=+Y
K X,Y,DIR
S DIR(0)="NO^1:9999999"
S DIR("A")="Select the Remote Consult Entry #"
D ^DIR
I $D(DIRUT) Q
S GMRCREMC=Y
S GMRCO=$O(^GMR(123,"AIFC",GMRCSIT,GMRCREMC,0))
I '$G(GMRCO) D G EN
. W $C(7),!!
. W "No Consult on file for the selected site with that remote number!"
. W !!
. K DIR
. S DIR(0)="E" D ^DIR
. W !,"Select again"
S DFN=$P(^GMR(123,GMRCO,0),U,2)
K DIR
S DIR(0)="S^B:brief;D:detailed"
S DIR("A")="Display type"
S DIR("B")="B"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q
S GMRCDISP=Y
I GMRCDISP="B" D G EN
. N GMRCST,GMRCSS,GMRCPNM,GMRCSN
. D DEM^GMRCU
. S GMRCSN=$P(GMRCSN,"-",3)
. S GMRCPNM=$E(GMRCPNM,1,23)
. S GMRCST=$$GET1^DIQ(100.01,$P(^GMR(123,GMRCO,0),U,12),.1)
. S GMRCSS=$E($$SVC^GMRCAU(GMRCO),1,22)
. W !!,"Local cslt# To Service",?37,"Status Patient",?74,"SSN"
. W !,$$REPEAT^XLFSTR("-",79)
. W !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCSN,!!
. K DIR S DIR(0)="E" D ^DIR
. W !,"Select again"
. D ^GMRCREXT
I GMRCDISP="D" D G EN
. D DT^GMRCSLM2(GMRCO)
. I '$D(^TMP("GMRCR",$J,"DT")) W !,"Error finding details!" Q
. M ^TMP("GMRCR",$J,"DTLIST")=^TMP("GMRCR",$J,"DT")
. S VALMCNT=$O(^TMP("GMRCR",$J,"DTLIST"," "),-1)
. D EN^VALM("GMRC DETAILED DISPLAY")
. D ^GMRCREXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCILKP 1732 printed Apr 09, 2024@20:51:21 Page 2
GMRCILKP ;SLC/JFR - LOOK UP IFC BY REMOTE CONS #; 1/2/02 14:34
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
EN ; start here
+1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,GMRCSIT,GMRCO,DFN,GMRCREMC
+2 NEW VALMBCK,VALMCNT,GMRCA,GMRCDIF,GMRCDVL,GMRCLOC,GMRCWARD,GMRCX,GMRCDISP
+3 SET DIR(0)="PO^4:EMQ"
+4 SET DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
+5 SET DIR("A")="Choose the facility to which the remote entry belongs"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET GMRCSIT=+Y
+9 KILL X,Y,DIR
+10 SET DIR(0)="NO^1:9999999"
+11 SET DIR("A")="Select the Remote Consult Entry #"
+12 DO ^DIR
+13 IF $DATA(DIRUT)
QUIT
+14 SET GMRCREMC=Y
+15 SET GMRCO=$ORDER(^GMR(123,"AIFC",GMRCSIT,GMRCREMC,0))
+16 IF '$GET(GMRCO)
Begin DoDot:1
+17 WRITE $CHAR(7),!!
+18 WRITE "No Consult on file for the selected site with that remote number!"
+19 WRITE !!
+20 KILL DIR
+21 SET DIR(0)="E"
DO ^DIR
+22 WRITE !,"Select again"
End DoDot:1
GOTO EN
+23 SET DFN=$PIECE(^GMR(123,GMRCO,0),U,2)
+24 KILL DIR
+25 SET DIR(0)="S^B:brief;D:detailed"
+26 SET DIR("A")="Display type"
+27 SET DIR("B")="B"
+28 DO ^DIR
+29 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+30 SET GMRCDISP=Y
+31 IF GMRCDISP="B"
Begin DoDot:1
+32 NEW GMRCST,GMRCSS,GMRCPNM,GMRCSN
+33 DO DEM^GMRCU
+34 SET GMRCSN=$PIECE(GMRCSN,"-",3)
+35 SET GMRCPNM=$EXTRACT(GMRCPNM,1,23)
+36 SET GMRCST=$$GET1^DIQ(100.01,$PIECE(^GMR(123,GMRCO,0),U,12),.1)
+37 SET GMRCSS=$EXTRACT($$SVC^GMRCAU(GMRCO),1,22)
+38 WRITE !!,"Local cslt# To Service",?37,"Status Patient",?74,"SSN"
+39 WRITE !,$$REPEAT^XLFSTR("-",79)
+40 WRITE !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCSN,!!
+41 KILL DIR
SET DIR(0)="E"
DO ^DIR
+42 WRITE !,"Select again"
+43 DO ^GMRCREXT
End DoDot:1
GOTO EN
+44 IF GMRCDISP="D"
Begin DoDot:1
+45 DO DT^GMRCSLM2(GMRCO)
+46 IF '$DATA(^TMP("GMRCR",$JOB,"DT"))
WRITE !,"Error finding details!"
QUIT
+47 MERGE ^TMP("GMRCR",$JOB,"DTLIST")=^TMP("GMRCR",$JOB,"DT")
+48 SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DTLIST"," "),-1)
+49 DO EN^VALM("GMRC DETAILED DISPLAY")
+50 DO ^GMRCREXT
End DoDot:1
GOTO EN
+51 QUIT
