GMRCASF.m

GMRCASF ;SLC/DLT - Significant Findings Action ;7/11/03 13:28

 ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,22,29,35,46**;DEC 27, 1997;Build 23

SF(GMRCO) ;Evaluate Significant Findings and update accordingly

 ;GMRCO is the selected consult

 N GMRCQIT,GMRCLCK

 I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)  I $D(GMRCQUT) D END Q

 I '+($G(GMRCO)) D END 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

 . D END

 I '$$LOCK^GMRCA1(GMRCO) D END Q

 S GMRCLCK=1

 ;

 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1

 N GMRC,GMRCSTS,GMRCSF,GMRCSFO,GMRCORTX,GMRCDR

 S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:GMRC(0)=""

 ;

 S GMRCSFO=$P(GMRC(0),"^",19)

 W !!,"Current Significant Findings = "_$S(GMRCSFO="U":"Unknown",GMRCSFO="Y":"Yes",GMRCSFO="N":"No",1:"not entered yet"),!!

 S GMRCSF=$$GETSIGF(GMRCSFO)

 I GMRCSF=0 D END Q

 ; If no change in old and new value ask if should continue

 I GMRCSF=GMRCSFO D  I 'Y D END Q

 . W !,"The old and new Significant Findings are the same."

 . N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT

 . S DIR("A")="Do you want to proceed with this action"

 . S DIR(0)="Y"

 . S DIR("B")="NO"

 . D ^DIR

 . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=0 Q

 . I Y=0 Q

 ;

 ;Update last action and sig findings but don't change the status

 S GMRCSTS=$P(GMRC(0),"^",12),GMRCA=4

 S GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"

 D STATUS^GMRCP

 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q

 ;

 ;GMRCOM=1 tells AUDIT^GMRCP to do the word-processing logic

 ;If an actual comment is added, $P(GMRCOM,"^",2)=1 (send alert),

 ; if not GMRCOM=1 and no '^' exists (do not send alert)

 S GMRCOM=1 D AUDIT^GMRCP

 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q

 ;

 I GMRCSTS=2 D EN^GMRCHL7($P(^GMR(123,GMRCO,0),U,2),GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),,,$G(GMRCAD))

 D SETORTX

 I GMRCSTS=2 D SENDALRT(GMRCORTX) Q

 I +$P(GMRCOM,"^",2) D

 . W !,"An alert with the following text will be sent if recipients are selected: "

 . W !,"     "_GMRCORTX_$$ORTX^GMRCAU(+GMRCO)

 . W !

 . I GMRCSTS'=2 W !,"or the alert will be sent when the order is completed.",!

 . I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D

 . W !!,"The ordering provider for this inter-facility consult will "

 . W "automatically be ",!,"notified.",!

 . D PROCALRT^GMRCACMT(GMRCORTX,1,4,GMRCO)

 . ;For consults not completed, the original provider may be deleted from

 . ;the recipient list for the alert.

 D END

 Q

 ;

SETORTX ;Set prefix text for the alert

 S GMRCORTX=$S(GMRCSF="N":"No ",GMRCSF="Y":"",1:"Unknown ")

 S GMRCORTX=GMRCORTX_"Sig Findings for "_$P($G(^ORD(100.01,+GMRCSTS,0)),"^",2)_" consult " Q

 Q

 ;

SENDALRT(GMRCORTX) ;Send to the requesting provider

 N GMRCRP,GMRCADUZ,GMRCDELR

 S GMRCRP=$P($G(^GMR(123,+GMRCO,0)),U,14) ;requesting clinician

 I +GMRCRP,GMRCRP'=DUZ D

 . S GMRCADUZ(+GMRCRP)=""

 . W !,"Alert will be sent to Requesting Provider: "_$P($G(^VA(200,+GMRCRP,0)),U,1)

 E  W !,"No automatic alerts will be sent to the Requesting Provider."

 S GMRCDELR=0

 D ANDTO^GMRCACMT

 D SENDMSG^GMRCACMT(23,+GMRCO)

 ;Sig Findings uses the CONSULT/REQUEST RESOLUTION (23) notification

 Q

 ;

GETSIGF(GMRCSFO) ;Get the significant findings

 ;GMRCSFO is the old significant findings value

 N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT

 S DIR(0)="123,15"

 S DIR("B")=GMRCSFO

 S:DIR("B")="" DIR("B")="unknown"

 S DIR("A")="Are there significant findings? (Y/N/U)"

 D ^DIR

 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q 0

 Q Y

 ;

END ;cleanup variables

 I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)

 K GMRCO,GMRCA,GMRCMSG,GMRCOM,GMRCSEL,GMRCERR,GMRCERMS

 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""

 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRCASF   3869     printed  Mar 13, 2025@20:49:47                                                                                                                                                                                                     Page 2

GMRCASF   ;SLC/DLT - Significant Findings Action ;7/11/03 13:28

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,22,29,35,46**;DEC 27, 1997;Build 23

SF(GMRCO) ;Evaluate Significant Findings and update accordingly

 +1       ;GMRCO is the selected consult

 +2        NEW GMRCQIT,GMRCLCK

 +3        IF '$LENGTH($GET(GMRCO))

               DO SELECT^GMRCA2(.GMRCO)

               IF $DATA(GMRCQUT)

                   DO END

                   QUIT 

 +4        IF '+($GET(GMRCO))

               DO END

               QUIT 

 +5        IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"

               Begin DoDot:1

 +6                NEW DIR

 +7                WRITE !,"The requesting facility may not take this action on an "

 +8                WRITE "inter-facility consult."

 +9                SET DIR(0)="E"

                   DO ^DIR

 +10               DO END

               End DoDot:1

               QUIT 

 +11       IF '$$LOCK^GMRCA1(GMRCO)

               DO END

               QUIT 

 +12       SET GMRCLCK=1

 +13      ;

 +14       IF $DATA(IOTM)

               IF $DATA(IOBM)

                   IF $DATA(IOSTBM)

                       DO FULL^VALM1

 +15       NEW GMRC,GMRCSTS,GMRCSF,GMRCSFO,GMRCORTX,GMRCDR

 +16       SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))

           if GMRC(0)=""

               QUIT 

 +17      ;

 +18       SET GMRCSFO=$PIECE(GMRC(0),"^",19)

 +19       WRITE !!,"Current Significant Findings = "_$SELECT(GMRCSFO="U":"Unknown",GMRCSFO="Y":"Yes",GMRCSFO="N":"No",1:"not entered yet"),!!

 +20       SET GMRCSF=$$GETSIGF(GMRCSFO)

 +21       IF GMRCSF=0

               DO END

               QUIT 

 +22      ; If no change in old and new value ask if should continue

 +23       IF GMRCSF=GMRCSFO

               Begin DoDot:1

 +24               WRITE !,"The old and new Significant Findings are the same."

 +25               NEW DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT

 +26               SET DIR("A")="Do you want to proceed with this action"

 +27               SET DIR(0)="Y"

 +28               SET DIR("B")="NO"

 +29               DO ^DIR

 +30               IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

                       SET Y=0

                       QUIT 

 +31               IF Y=0

                       QUIT 

               End DoDot:1

               IF 'Y

                   DO END

                   QUIT 

 +32      ;

 +33      ;Update last action and sig findings but don't change the status

 +34       SET GMRCSTS=$PIECE(GMRC(0),"^",12)

           SET GMRCA=4

 +35       SET GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"

 +36       DO STATUS^GMRCP

 +37       IF $GET(GMRCERR)=1

               SET GMRCMSG=GMRCERMS

               DO EXAC^GMRCADC(GMRCMSG)

               DO END

               QUIT 

 +38      ;

 +39      ;GMRCOM=1 tells AUDIT^GMRCP to do the word-processing logic

 +40      ;If an actual comment is added, $P(GMRCOM,"^",2)=1 (send alert),

 +41      ; if not GMRCOM=1 and no '^' exists (do not send alert)

 +42       SET GMRCOM=1

           DO AUDIT^GMRCP

 +43       IF $GET(GMRCERR)=1

               SET GMRCMSG=GMRCERMS

               DO EXAC^GMRCADC(GMRCMSG)

               DO END

               QUIT 

 +44      ;

 +45       IF GMRCSTS=2

               DO EN^GMRCHL7($PIECE(^GMR(123,GMRCO,0),U,2),GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),,,$GET(GMRCAD))

 +46       DO SETORTX

 +47       IF GMRCSTS=2

               DO SENDALRT(GMRCORTX)

               QUIT 

 +48       IF +$PIECE(GMRCOM,"^",2)

               Begin DoDot:1

 +49               WRITE !,"An alert with the following text will be sent if recipients are selected: "

 +50               WRITE !,"     "_GMRCORTX_$$ORTX^GMRCAU(+GMRCO)

 +51               WRITE !

 +52               IF GMRCSTS'=2

                       WRITE !,"or the alert will be sent when the order is completed.",!

 +53               IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="F"

                       Begin DoDot:2

                       End DoDot:2

 +54               WRITE !!,"The ordering provider for this inter-facility consult will "

 +55               WRITE "automatically be ",!,"notified.",!

 +56               DO PROCALRT^GMRCACMT(GMRCORTX,1,4,GMRCO)

 +57      ;For consults not completed, the original provider may be deleted from

 +58      ;the recipient list for the alert.

               End DoDot:1

 +59       DO END

 +60       QUIT 

 +61      ;

SETORTX   ;Set prefix text for the alert

 +1        SET GMRCORTX=$SELECT(GMRCSF="N":"No ",GMRCSF="Y":"",1:"Unknown ")

 +2        SET GMRCORTX=GMRCORTX_"Sig Findings for "_$PIECE($GET(^ORD(100.01,+GMRCSTS,0)),"^",2)_" consult "

           QUIT 

 +3        QUIT 

 +4       ;

SENDALRT(GMRCORTX) ;Send to the requesting provider

 +1        NEW GMRCRP,GMRCADUZ,GMRCDELR

 +2       ;requesting clinician

           SET GMRCRP=$PIECE($GET(^GMR(123,+GMRCO,0)),U,14)

 +3        IF +GMRCRP

               IF GMRCRP'=DUZ

                   Begin DoDot:1

 +4                    SET GMRCADUZ(+GMRCRP)=""

 +5                    WRITE !,"Alert will be sent to Requesting Provider: "_$PIECE($GET(^VA(200,+GMRCRP,0)),U,1)

                   End DoDot:1

 +6       IF '$TEST

               WRITE !,"No automatic alerts will be sent to the Requesting Provider."

 +7        SET GMRCDELR=0

 +8        DO ANDTO^GMRCACMT

 +9        DO SENDMSG^GMRCACMT(23,+GMRCO)

 +10      ;Sig Findings uses the CONSULT/REQUEST RESOLUTION (23) notification

 +11       QUIT 

 +12      ;

GETSIGF(GMRCSFO) ;Get the significant findings

 +1       ;GMRCSFO is the old significant findings value

 +2        NEW DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT

 +3        SET DIR(0)="123,15"

 +4        SET DIR("B")=GMRCSFO

 +5        if DIR("B")=""

               SET DIR("B")="unknown"

 +6        SET DIR("A")="Are there significant findings? (Y/N/U)"

 +7        DO ^DIR

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

               QUIT 0

 +9        QUIT Y

 +10      ;

END       ;cleanup variables

 +1        IF $GET(GMRCLCK)

               DO UNLOCK^GMRCA1(GMRCO)

 +2        KILL GMRCO,GMRCA,GMRCMSG,GMRCOM,GMRCSEL,GMRCERR,GMRCERMS

 +3        IF $DATA(DTOUT)!$DATA(DIROUT)

               SET GMRCQIT=""

 +4        if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))

               SET XQORM("HIJACK")=^("MENU")

 +5        QUIT