GMRCILKP.m

GMRCILKP ;SLC/JFR - LOOK UP IFC BY REMOTE CONS #;15-Mar-2012 10:39;PLS

 ;;3.0;CONSULT/REQUEST TRACKING;**22,1001,1003**;DEC 27, 1997;Build 14

 ;Modified - IHS/CIA/MGH - 11/28/2005 - Line EN+38  -  Modified to use hrcn instead of SSN

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"

 . ;IHS/CIA/MGH Modified to use HRCN instead of SSN

 . W !!,"Local cslt#   To Service",?37,"Status   Patient",?74,"HRCN"

 . W !,$$REPEAT^XLFSTR("-",79)

 . ;W !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCSN,!!

 . W !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCHRCN,!!

 . 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

GMRCILKP  ;SLC/JFR - LOOK UP IFC BY REMOTE CONS #;15-Mar-2012 10:39;PLS

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**22,1001,1003**;DEC 27, 1997;Build 14

 +2       ;Modified - IHS/CIA/MGH - 11/28/2005 - Line EN+38  -  Modified to use hrcn instead of SSN

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      ;W !!,"Local cslt#   To Service",?37,"Status   Patient",?74,"SSN"

 +39      ;IHS/CIA/MGH Modified to use HRCN instead of SSN

 +40               WRITE !!,"Local cslt#   To Service",?37,"Status   Patient",?74,"HRCN"

 +41               WRITE !,$$REPEAT^XLFSTR("-",79)

 +42      ;W !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCSN,!!

 +43               WRITE !,GMRCO,?14,GMRCSS,?39,GMRCST,?46,GMRCPNM,?74,GMRCHRCN,!!

 +44               KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

 +45               WRITE !,"Select again"

 +46               DO ^GMRCREXT

               End DoDot:1

               GOTO EN

 +47       IF GMRCDISP="D"

               Begin DoDot:1

 +48               DO DT^GMRCSLM2(GMRCO)

 +49               IF '$DATA(^TMP("GMRCR",$JOB,"DT"))

                       WRITE !,"Error finding details!"

                       QUIT 

 +50               MERGE ^TMP("GMRCR",$JOB,"DTLIST")=^TMP("GMRCR",$JOB,"DT")

 +51               SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DTLIST"," "),-1)

 +52               DO EN^VALM("GMRC DETAILED DISPLAY")

 +53               DO ^GMRCREXT

               End DoDot:1

               GOTO EN

 +54       QUIT