- GMRCEDT2 ;SLC/JFR,DCM - RESUBMIT A CANCELLED CONSULT ;10/09/15 13:08
- ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33,66,46,73,85**;DEC 27, 1997;Build 3
- ;
- ;ICRs in use: #2053 (DIE), #2056 (GET1^DIQ), #872 (ORD(101))
- ;patch 85 removed call to $$PDOK^GMRCEDT4
- ;
- EN(GMRCO,COMNO) ;entry point into the routine
- ;COMNO=CMDA from ^GMRCEDT2=comments array IEN from ^GMR(123,IEN,40,
- ;GMRCO=IEN of the consult from file 123
- I $S($P(^GMR(123,GMRCO,0),"^",12)'=13:1,$D(GMRCRSUB):1,1:0) D Q
- .S GMRCMSG="*** Consult Has Already Been Resubmitted ***"
- .S GMRCMSG(1)="*** No Further Action Is Required Or Allowed ***"
- .D EXAC^GMRCADC(.GMRCMSG)
- .S:'$D(GMRCRSUB) GMRCRSUB=1
- .Q
- N MSG S MSG=$$EDRESOK(GMRCO)
- I '+MSG D EXAC^GMRCADC($P(MSG,U,2)) Q
- I '$D(GMRCGUIF) W !,"Resubmitting Consult ... One moment please ..."
- K ^TMP("GMRCSUB",$J) S ^TMP("GMRCSUB",$J)=0
- I $D(GMRCEDT(1)) S ^TMP("GMRCSUB",$J,1)="GMRCSS^"_+GMRCEDT(1)
- I $D(GMRCED(1)) D
- . I $P(GMRCED(1),U)=$P(^GMR(123,+GMRCO,0),U,8) K GMRCED(1) Q
- . S ^TMP("GMRCSUB",$J,2)="GMRCPROC^"_+GMRCED(1)_";GMR(123.3,"
- I $D(GMRCED(2)) D
- . I $P(GMRCED(2),U)=$P(^GMR(123,+GMRCO,0),U,18) K GMRCED(2) Q
- . S ^TMP("GMRCSUB",$J,3)="GMRCION^"_$P(GMRCED(2),U)
- I $D(GMRCED(3)) D
- . I $P(GMRCED(3),U)=$P(^GMR(123,+GMRCO,0),U,9) K GMRCED(3) Q
- . S ^TMP("GMRCSUB",$J,4)="GMRCURG^"_$P(GMRCED(3),U)
- I $D(GMRCED(4)) D
- . I $P(GMRCED(4),U)=$P(^GMR(123,+GMRCO,0),U,10) K GMRCED(4) Q
- . S ^TMP("GMRCSUB",$J,5)="GMRCPL^"_$P(GMRCED(4),U)
- I $D(GMRCED(5)) D ;wat/66 add early date
- . I $P(GMRCED(5),U)=$P(^GMR(123,+GMRCO,0),U,24) K GMRCED(5) Q
- . S ^TMP("GMRCSUB",$J,6)="GMRCERDT^"_$P(GMRCED(5),U)
- I $D(GMRCED(6)) D
- . I $P(GMRCED(6),U)=$P(^GMR(123,+GMRCO,0),U,11) K GMRCED(6) Q
- . I '$L($P(GMRCED(6),U)) S $P(GMRCED(6),U)="@"
- . S ^TMP("GMRCSUB",$J,7)="GMRCATN^"_$P(GMRCED(6),U)
- I $D(GMRCED(7)) D
- . I GMRCED(7)=$G(^GMR(123,+GMRCO,30)) K GMRCED(7) Q
- . I $P(GMRCED(7),U)_" ("_$P(GMRCED(7),U,2)_")"=$G(^GMR(123,GMRCO,30)) K GMRCED(7) Q
- . I '$L($P(GMRCED(7),U)) S $P(GMRCED(7),U,1,2)="@"
- . S ^TMP("GMRCSUB",$J,8)="GMRCDIAG^"_GMRCED(7)
- I $D(^TMP("GMRCED",$J,20)) S ^TMP("GMRCSUB",$J,20)="GMRCRFQ^" D
- . N ND S ND=0
- . F S ND=$O(^TMP("GMRCED",$J,20,ND)) Q:'ND D
- .. S ^TMP("GMRCSUB",$J,20,ND)=^TMP("GMRCED",$J,20,ND,0)
- I $D(^TMP("GMRCED",$J,40)) S ^TMP("GMRCSUB",$J,40)="COMMENT^" D
- . N ND S ND=0
- . F S ND=$O(^TMP("GMRCED",$J,40,ND)) Q:'ND D
- .. S ^TMP("GMRCSUB",$J,40,ND)=^TMP("GMRCED",$J,40,ND,0)
- D FILE^GMRCGUIC(+GMRCO,$NAME(^TMP("GMRCSUB",$J)),1)
- N GMRCADUZ S GMRCADUZ=""
- S DFN=$P(^GMR(123,+GMRCO,0),"^",2),GMRCPROV=$P(^(0),"^",14)
- S GMRCTYPE=$P(^GMR(123,+GMRCO,0),U,17),GMRCTRLC="XX",VISIT="",RMBED=""
- S DIE="^GMR(123,",DA=+GMRCO,DR="8////^S X=5;9////^S X=11" D ^DIE
- K DIE,DA,DR
- S GMRCRSUB=1
- S GMRCURG=$P(^GMR(123,+GMRCO,0),"^",9)
- I +$P(^GMR(123,+GMRCO,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
- S GMRCSVC=$P(^GMR(123,+GMRCO,0),"^",5)
- I +GMRCSVC D
- . D EN^GMRCT(GMRCSVC)
- S GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)_$S(+GMRCURG:" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
- K GMRCFL,GMRCPROV,GMRCTYPE,GMRCTRLC,VISIT,RMBED,GMRCOM,GMRCURG
- K GMRCSVC,GMRCORTX
- Q
- EDRESOK(GMRCDA) ;check cslt or proc to see if still resubmittable
- ; if procedure is inactive or no services, not resubmittable
- ; if service is grouper or disabled, not resubmittable
- N MSG,GMRC
- Q:'$D(^GMR(123,+$G(GMRCDA),0)) "0^Invalid Consult Number"
- I $P($G(^GMR(123,+GMRCDA,12)),U,5)="F" D Q MSG
- . S MSG="0^This inter-facility cconsult may only be resubmitted by the"
- . S MSG=MSG_" ordering facility."
- S GMRC(0)=^GMR(123,+GMRCDA,0)
- I '$P(GMRC(0),U,8) D Q MSG
- . I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) D Q
- .. S MSG="0^The service for this Consult is no longer orderable."
- . S MSG=1
- S MSG=1
- I "19"[+$P(^GMR(123.5,+$P(GMRC(0),U,5),0),U,2) S MSG=0
- I '$L($$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.01)) S MSG=0
- I +$$GET1^DIQ(123.3,+$P(GMRC(0),U,8),.02) S MSG=0
- I '$D(^GMR(123.3,+$P(GMRC(0),U,8),2,"B",+$P(GMRC(0),U,5))) S MSG=0
- I MSG=0 D
- . S MSG=MSG_"^This procedure may no longer be ordered or the service "
- . S MSG=MSG_"may no longer perform it."
- Q MSG
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCEDT2 4198 printed Apr 23, 2025@18:00 Page 2
- GMRCEDT2 ;SLC/JFR,DCM - RESUBMIT A CANCELLED CONSULT ;10/09/15 13:08
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33,66,46,73,85**;DEC 27, 1997;Build 3
- +2 ;
- +3 ;ICRs in use: #2053 (DIE), #2056 (GET1^DIQ), #872 (ORD(101))
- +4 ;patch 85 removed call to $$PDOK^GMRCEDT4
- +5 ;
- EN(GMRCO,COMNO) ;entry point into the routine
- +1 ;COMNO=CMDA from ^GMRCEDT2=comments array IEN from ^GMR(123,IEN,40,
- +2 ;GMRCO=IEN of the consult from file 123
- +3 IF $SELECT($PIECE(^GMR(123,GMRCO,0),"^",12)'=13:1,$DATA(GMRCRSUB):1,1:0)
- Begin DoDot:1
- +4 SET GMRCMSG="*** Consult Has Already Been Resubmitted ***"
- +5 SET GMRCMSG(1)="*** No Further Action Is Required Or Allowed ***"
- +6 DO EXAC^GMRCADC(.GMRCMSG)
- +7 if '$DATA(GMRCRSUB)
- SET GMRCRSUB=1
- +8 QUIT
- End DoDot:1
- QUIT
- +9 NEW MSG
- SET MSG=$$EDRESOK(GMRCO)
- +10 IF '+MSG
- DO EXAC^GMRCADC($PIECE(MSG,U,2))
- QUIT
- +11 IF '$DATA(GMRCGUIF)
- WRITE !,"Resubmitting Consult ... One moment please ..."
- +12 KILL ^TMP("GMRCSUB",$JOB)
- SET ^TMP("GMRCSUB",$JOB)=0
- +13 IF $DATA(GMRCEDT(1))
- SET ^TMP("GMRCSUB",$JOB,1)="GMRCSS^"_+GMRCEDT(1)
- +14 IF $DATA(GMRCED(1))
- Begin DoDot:1
- +15 IF $PIECE(GMRCED(1),U)=$PIECE(^GMR(123,+GMRCO,0),U,8)
- KILL GMRCED(1)
- QUIT
- +16 SET ^TMP("GMRCSUB",$JOB,2)="GMRCPROC^"_+GMRCED(1)_";GMR(123.3,"
- End DoDot:1
- +17 IF $DATA(GMRCED(2))
- Begin DoDot:1
- +18 IF $PIECE(GMRCED(2),U)=$PIECE(^GMR(123,+GMRCO,0),U,18)
- KILL GMRCED(2)
- QUIT
- +19 SET ^TMP("GMRCSUB",$JOB,3)="GMRCION^"_$PIECE(GMRCED(2),U)
- End DoDot:1
- +20 IF $DATA(GMRCED(3))
- Begin DoDot:1
- +21 IF $PIECE(GMRCED(3),U)=$PIECE(^GMR(123,+GMRCO,0),U,9)
- KILL GMRCED(3)
- QUIT
- +22 SET ^TMP("GMRCSUB",$JOB,4)="GMRCURG^"_$PIECE(GMRCED(3),U)
- End DoDot:1
- +23 IF $DATA(GMRCED(4))
- Begin DoDot:1
- +24 IF $PIECE(GMRCED(4),U)=$PIECE(^GMR(123,+GMRCO,0),U,10)
- KILL GMRCED(4)
- QUIT
- +25 SET ^TMP("GMRCSUB",$JOB,5)="GMRCPL^"_$PIECE(GMRCED(4),U)
- End DoDot:1
- +26 ;wat/66 add early date
- IF $DATA(GMRCED(5))
- Begin DoDot:1
- +27 IF $PIECE(GMRCED(5),U)=$PIECE(^GMR(123,+GMRCO,0),U,24)
- KILL GMRCED(5)
- QUIT
- +28 SET ^TMP("GMRCSUB",$JOB,6)="GMRCERDT^"_$PIECE(GMRCED(5),U)
- End DoDot:1
- +29 IF $DATA(GMRCED(6))
- Begin DoDot:1
- +30 IF $PIECE(GMRCED(6),U)=$PIECE(^GMR(123,+GMRCO,0),U,11)
- KILL GMRCED(6)
- QUIT
- +31 IF '$LENGTH($PIECE(GMRCED(6),U))
- SET $PIECE(GMRCED(6),U)="@"
- +32 SET ^TMP("GMRCSUB",$JOB,7)="GMRCATN^"_$PIECE(GMRCED(6),U)
- End DoDot:1
- +33 IF $DATA(GMRCED(7))
- Begin DoDot:1
- +34 IF GMRCED(7)=$GET(^GMR(123,+GMRCO,30))
- KILL GMRCED(7)
- QUIT
- +35 IF $PIECE(GMRCED(7),U)_" ("_$PIECE(GMRCED(7),U,2)_")"=$GET(^GMR(123,GMRCO,30))
- KILL GMRCED(7)
- QUIT
- +36 IF '$LENGTH($PIECE(GMRCED(7),U))
- SET $PIECE(GMRCED(7),U,1,2)="@"
- +37 SET ^TMP("GMRCSUB",$JOB,8)="GMRCDIAG^"_GMRCED(7)
- End DoDot:1
- +38 IF $DATA(^TMP("GMRCED",$JOB,20))
- SET ^TMP("GMRCSUB",$JOB,20)="GMRCRFQ^"
- Begin DoDot:1
- +39 NEW ND
- SET ND=0
- +40 FOR
- SET ND=$ORDER(^TMP("GMRCED",$JOB,20,ND))
- if 'ND
- QUIT
- Begin DoDot:2
- +41 SET ^TMP("GMRCSUB",$JOB,20,ND)=^TMP("GMRCED",$JOB,20,ND,0)
- End DoDot:2
- End DoDot:1
- +42 IF $DATA(^TMP("GMRCED",$JOB,40))
- SET ^TMP("GMRCSUB",$JOB,40)="COMMENT^"
- Begin DoDot:1
- +43 NEW ND
- SET ND=0
- +44 FOR
- SET ND=$ORDER(^TMP("GMRCED",$JOB,40,ND))
- if 'ND
- QUIT
- Begin DoDot:2
- +45 SET ^TMP("GMRCSUB",$JOB,40,ND)=^TMP("GMRCED",$JOB,40,ND,0)
- End DoDot:2
- End DoDot:1
- +46 DO FILE^GMRCGUIC(+GMRCO,$NAME(^TMP("GMRCSUB",$JOB)),1)
- +47 NEW GMRCADUZ
- SET GMRCADUZ=""
- +48 SET DFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
- SET GMRCPROV=$PIECE(^(0),"^",14)
- +49 SET GMRCTYPE=$PIECE(^GMR(123,+GMRCO,0),U,17)
- SET GMRCTRLC="XX"
- SET VISIT=""
- SET RMBED=""
- +50 SET DIE="^GMR(123,"
- SET DA=+GMRCO
- SET DR="8////^S X=5;9////^S X=11"
- DO ^DIE
- +51 KILL DIE,DA,DR
- +52 SET GMRCRSUB=1
- +53 SET GMRCURG=$PIECE(^GMR(123,+GMRCO,0),"^",9)
- +54 IF +$PIECE(^GMR(123,+GMRCO,0),"^",11)
- SET GMRCADUZ($PIECE(^(0),"^",11))=""
- +55 SET GMRCSVC=$PIECE(^GMR(123,+GMRCO,0),"^",5)
- +56 IF +GMRCSVC
- Begin DoDot:1
- +57 DO EN^GMRCT(GMRCSVC)
- End DoDot:1
- +58 SET GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)_$SELECT(+GMRCURG:" ("_$PIECE(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
- +59 KILL GMRCFL,GMRCPROV,GMRCTYPE,GMRCTRLC,VISIT,RMBED,GMRCOM,GMRCURG
- +60 KILL GMRCSVC,GMRCORTX
- +61 QUIT
- EDRESOK(GMRCDA) ;check cslt or proc to see if still resubmittable
- +1 ; if procedure is inactive or no services, not resubmittable
- +2 ; if service is grouper or disabled, not resubmittable
- +3 NEW MSG,GMRC
- +4 if '$DATA(^GMR(123,+$GET(GMRCDA),0))
- QUIT "0^Invalid Consult Number"
- +5 IF $PIECE($GET(^GMR(123,+GMRCDA,12)),U,5)="F"
- Begin DoDot:1
- +6 SET MSG="0^This inter-facility cconsult may only be resubmitted by the"
- +7 SET MSG=MSG_" ordering facility."
- End DoDot:1
- QUIT MSG
- +8 SET GMRC(0)=^GMR(123,+GMRCDA,0)
- +9 IF '$PIECE(GMRC(0),U,8)
- Begin DoDot:1
- +10 IF "19"[+$PIECE(^GMR(123.5,+$PIECE(GMRC(0),U,5),0),U,2)
- Begin DoDot:2
- +11 SET MSG="0^The service for this Consult is no longer orderable."
- End DoDot:2
- QUIT
- +12 SET MSG=1
- End DoDot:1
- QUIT MSG
- +13 SET MSG=1
- +14 IF "19"[+$PIECE(^GMR(123.5,+$PIECE(GMRC(0),U,5),0),U,2)
- SET MSG=0
- +15 IF '$LENGTH($$GET1^DIQ(123.3,+$PIECE(GMRC(0),U,8),.01))
- SET MSG=0
- +16 IF +$$GET1^DIQ(123.3,+$PIECE(GMRC(0),U,8),.02)
- SET MSG=0
- +17 IF '$DATA(^GMR(123.3,+$PIECE(GMRC(0),U,8),2,"B",+$PIECE(GMRC(0),U,5)))
- SET MSG=0
- +18 IF MSG=0
- Begin DoDot:1
- +19 SET MSG=MSG_"^This procedure may no longer be ordered or the service "
- +20 SET MSG=MSG_"may no longer perform it."
- End DoDot:1
- +21 QUIT MSG
