- GMRCEDT1 ;SLC/DCM,JFR - EDIT A CONSULT AND RE-SEND AS NEW ;3/20/03 22:22
- ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33,47**;DEC 27, 1997
- ;
- ; This routine invokes IA #2638,#3991
- ;
- EN(GMRCO) ;GMRCO=IEN of consult from file 123
- ;GMRCSS=To Service GMRCPROC=Procedure Request Type
- ;GMRCURG=Urgency GMRCPL=Place Of Consultation
- ;GMRCATN=Attention GMRCINO=Service is In/Out Patient
- ;GMRCPNM=Patient Name GMRCDIAG=Provisional Diagnosis
- N GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCINO,GMRCDIAG,LN,GMRCRESP
- K ^TMP("GMRCR",$J,"ED") S GMRCLNO=1
- I $L($P(^GMR(123,+GMRCO,0),"^",12)) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" CURRENT STATUS: (Not Editable): "_$P(^ORD(100.01,$P(^(0),"^",12),0),"^",1),GMRCLNO=GMRCLNO+1
- S GMRCD=0 F S GMRCD=$O(^GMR(123,+GMRCO,40,"B",GMRCD)) Q:'GMRCD S GMRCDD="" F S GMRCDD=$O(^GMR(123,GMRCO,40,"B",GMRCD,GMRCDD)) Q:'GMRCDD D
- .I $P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=19 S LN=0 D
- ..N GMRCPERS,GMRCTX
- ..I '$D(^GMR(123,+GMRCO,12)) D
- ...S GMRCPERS=+$P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)
- ...S GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
- ..I $D(^GMR(123,+GMRCO,12)) D
- ...I $P(^GMR(123,+GMRCO,12),U,5)="P" D
- ....S GMRCPERS=$P($G(^GMR(123,+GMRCO,40,GMRCDD,2)),U,1)
- ...I $P(^GMR(123,+GMRCO,12),U,5)="F" D
- ....S GMRCPERS=$P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),U,5)
- ....S GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
- ..S GMRCTX=" CANCELLED BY (Not Editable): "_GMRCPERS
- ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=GMRCTX,GMRCLNO=GMRCLNO+1
- ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" CANCELLED COMMENT (Not Editable):",GMRCLNO=GMRCLNO+1
- ..S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) I $L(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75 S FLG=1 D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG)
- ..I '$D(FLG) S LN=0 F S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^(LN,0),GMRCLNO=GMRCLNO+1
- ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",$P(^(0),"-",79)=""
- ..S GMRCLNO=GMRCLNO+1
- ..Q
- .Q
- S GMRCSS=$S($D(GMRCEDT(1)):GMRCEDT(1),1:$P(^GMR(123,+GMRCO,0),"^",5)_U_$P(^GMR(123.5,$P(^GMR(123,+GMRCO,0),"^",5),0),U))
- S GMRCPROC=$S($D(GMRCED(1)):GMRCED(1),1:$P(^GMR(123,+GMRCO,0),"^",8)_U_$$GET1^DIQ(123.3,+$P(^GMR(123,+GMRCO,0),"^",8),.01))
- S GMRCURG=$S($D(GMRCED(3)):GMRCED(3),1:$P(^GMR(123,+GMRCO,0),"^",9)_U_$$GET1^DIQ(101,+$P(^(0),"^",9),1))
- S GMRCPL=$S($D(GMRCED(4)):GMRCED(4),1:$P(^GMR(123,+GMRCO,0),"^",10)_U_$$GET1^DIQ(101,+$P(^(0),U,10),1))
- S GMRCATN=$S($D(GMRCED(5)):GMRCED(5),1:$P(^GMR(123,+GMRCO,0),"^",11)_U_$$GET1^DIQ(200,+$P(^(0),U,11),.01))
- I '$D(^GMR(123,GMRCO,30.1)) D
- . I $D(GMRCED(6)),$L($P(GMRCED(6),U,2)) D Q
- .. S GMRCDIAG=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
- . S GMRCDIAG=$S($D(GMRCED(6)):GMRCED(6),1:$G(^GMR(123,+GMRCO,30)))
- I $D(^GMR(123,GMRCO,30.1)) D
- . I $D(GMRCED(6)),$L(GMRCED(6)) D Q
- .. S GMRCDIAG=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
- . S GMRCDIAG=$G(^GMR(123,+GMRCO,30))
- . I '$$STATCHK^ICDAPIU(^GMR(123,GMRCO,30.1),DT) D
- .. S GMRCDIAG=GMRCDIAG_" <INACTIVE CODE>"
- I $D(GMRCED(2)) S GMRCINO=GMRCED(2)
- I '$D(GMRCINO) S GMRCINO=$P(^GMR(123,+GMRCO,0),U,18)_U_$S($P(^(0),U,18)="I":"Inpatient",1:"Outpatient")
- S GMRCREQ=$S(+$P(^GMR(123,+GMRCO,0),U,17)="P":"Procedure",1:"Consult")
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="SENDING PROVIDER (Not Editable): "_$S($P($G(^GMR(123,+GMRCO,12)),U,6):$P(^GMR(123,+GMRCO,12),U,6),$P(^GMR(123,+GMRCO,0),"^",14):$$GET1^DIQ(200,+$P(^GMR(123,+GMRCO,0),"^",14),.01),1:"UNKNOWN"),GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="REQUEST TYPE (Not Editable): "_GMRCREQ,GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=$$REPEAT^XLFSTR("-",79),GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" TO SERVICE (Not Editable): "_$P(GMRCSS,U,2) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" ",GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="1 PROCEDURE: "_$P(GMRCPROC,U,2)
- D:+GMRCPROC RVRS(GMRCLNO,$D(GMRCED(1))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="2 Performed as INPT OR OUTPT: "_$P(GMRCINO,U,2) D RVRS(GMRCLNO,$D(GMRCED(2))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="3 URGENCY: "_$P(GMRCURG,U,2) D RVRS(GMRCLNO,$D(GMRCED(3))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="4 PLACE OF CONSULTATION: "_$P(GMRCPL,U,2) D RVRS(GMRCLNO,$D(GMRCED(4))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="5 ATTENTION (CONSULTANT): "_$P(GMRCATN,U,2) D RVRS(GMRCLNO,$D(GMRCED(5))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="6 PROVISIONAL DIAGNOSIS: "_GMRCDIAG D RVRS(GMRCLNO,$D(GMRCED(6))) S GMRCLNO=GMRCLNO+1
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="7 REASON FOR REQUEST:" D RVRS(GMRCLNO,$D(^TMP("GMRCED",$J,20))) S GMRCLNO=GMRCLNO+1 D
- . I $D(^TMP("GMRCED",$J,20)) D Q
- .. N ND S ND=0
- .. F S ND=$O(^TMP("GMRCED",$J,20,ND)) Q:'ND D
- ... D KILL^VALM10(GMRCLNO)
- ... S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCED",$J,20,ND,0)
- ... S GMRCLNO=GMRCLNO+1
- . N ND S ND=0
- . F S ND=$O(^GMR(123,+GMRCO,20,ND)) Q:ND="" D
- .. S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^GMR(123,+GMRCO,20,ND,0)
- .. S GMRCLNO=GMRCLNO+1
- .Q
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",GMRCLNO=GMRCLNO+1,^TMP("GMRCR",$J,"ED",GMRCLNO,0)="8 COMMENT(S): (Add Only)" D RVRS(GMRCLNO) S GMRCLNO=GMRCLNO+1
- I $D(^TMP("GMRCED",$J,40)) D
- . D KILL^VALM10(GMRCLNO)
- . S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" New Comment:",GMRCLNO=GMRCLNO+1
- . N ND S ND=0 F S ND=$O(^TMP("GMRCED",$J,40,ND)) Q:'ND D
- .. S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCED",$J,40,ND,0)
- .. S GMRCLNO=GMRCLNO+1
- N GMRCEDCT
- S GMRCD=0,GMRCEDCT=0 F S GMRCD=$O(^GMR(123,+GMRCO,40,"B",GMRCD)) Q:'GMRCD S GMRCDD="",GMRCDD=$O(^GMR(123,+GMRCO,40,"B",GMRCD,GMRCDD)) Q:'GMRCDD D
- .I $P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=20 S LN=0,GMRCEDCT=GMRCEDCT+1,GMRCEDCM(GMRCEDCT)=GMRCDD D
- ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",GMRCLNO=GMRCLNO+1,^TMP("GMRCR",$J,"ED",GMRCLNO,0)="ADDED COMMENT (Not Editable) Entered: "_$P($$FMTE^XLFDT($P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",1)),"@",1)
- ..S GMRCRESP=$S($L($P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)):$P(^VA(200,$P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",5),0),"^",1),$L($P($G(^GMR(123,+GMRCO,40,GMRCDD,2)),"^",1)):$P(^GMR(123,+GMRCO,40,GMRCDD,2),"^",1),1:"UNKNOWN")
- ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCR",$J,"ED",GMRCLNO,0)_" BY: "_GMRCRESP,GMRCLNO=GMRCLNO+1
- ..;S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCR",$J,"ED",GMRCLNO,0)_" BY: "_$S($L($P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4)):$P(^VA(200,$P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4),0),"^",1),1:"UNKNOWN"),GMRCLNO=GMRCLNO+1
- ..S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) I $L(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75 S FLG=1 D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG) Q
- ..S LN=0 F S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^(LN,0),GMRCLNO=GMRCLNO+1
- ..Q
- .Q
- S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=""
- K FLG
- Q
- RVRS(LINE,EDITED) ;reverse video for fields that can be edited
- I '$G(EDITED) D CNTRL^VALM10(LINE,1,1,IORVON,IORVOFF) Q
- D CNTRL^VALM10(LINE,1,1,IORVON_IOINHI,IORVOFF_IOINORM)
- Q
- GMRCEDT1 ;SLC/DCM,JFR - EDIT A CONSULT AND RE-SEND AS NEW ;3/20/03 22:22
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33,47**;DEC 27, 1997
- +2 ;
- +3 ; This routine invokes IA #2638,#3991
- +4 ;
- EN(GMRCO) ;GMRCO=IEN of consult from file 123
- +1 ;GMRCSS=To Service GMRCPROC=Procedure Request Type
- +2 ;GMRCURG=Urgency GMRCPL=Place Of Consultation
- +3 ;GMRCATN=Attention GMRCINO=Service is In/Out Patient
- +4 ;GMRCPNM=Patient Name GMRCDIAG=Provisional Diagnosis
- +5 NEW GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCINO,GMRCDIAG,LN,GMRCRESP
- +6 KILL ^TMP("GMRCR",$JOB,"ED")
- SET GMRCLNO=1
- +7 IF $LENGTH($PIECE(^GMR(123,+GMRCO,0),"^",12))
- SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=" CURRENT STATUS: (Not Editable): "_$PIECE(^ORD(100.01,$PIECE(^(0),"^",12),0),"^",1)
- SET GMRCLNO=GMRCLNO+1
- +8 SET GMRCD=0
- FOR
- SET GMRCD=$ORDER(^GMR(123,+GMRCO,40,"B",GMRCD))
- IF 'GMRCD
- QUIT
- SET GMRCDD=""
- FOR
- SET GMRCDD=$ORDER(^GMR(123,GMRCO,40,"B",GMRCD,GMRCDD))
- IF 'GMRCDD
- QUIT
- Begin DoDot:1
- +9 IF $PIECE(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=19
- SET LN=0
- Begin DoDot:2
- +10 NEW GMRCPERS,GMRCTX
- +11 IF '$DATA(^GMR(123,+GMRCO,12))
- Begin DoDot:3
- +12 SET GMRCPERS=+$PIECE($GET(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)
- +13 SET GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
- End DoDot:3
- +14 IF $DATA(^GMR(123,+GMRCO,12))
- Begin DoDot:3
- +15 IF $PIECE(^GMR(123,+GMRCO,12),U,5)="P"
- Begin DoDot:4
- +16 SET GMRCPERS=$PIECE($GET(^GMR(123,+GMRCO,40,GMRCDD,2)),U,1)
- End DoDot:4
- +17 IF $PIECE(^GMR(123,+GMRCO,12),U,5)="F"
- Begin DoDot:4
- +18 SET GMRCPERS=$PIECE($GET(^GMR(123,+GMRCO,40,GMRCDD,0)),U,5)
- +19 SET GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
- End DoDot:4
- End DoDot:3
- +20 SET GMRCTX=" CANCELLED BY (Not Editable): "_GMRCPERS
- +21 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=GMRCTX
- SET GMRCLNO=GMRCLNO+1
- +22 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=" CANCELLED COMMENT (Not Editable):"
- SET GMRCLNO=GMRCLNO+1
- +23 SET LN=$ORDER(^GMR(123,+GMRCO,40,GMRCDD,1,LN))
- IF LN=""!(LN?1A.E)
- QUIT
- IF $LENGTH(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75
- SET FLG=1
- DO WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG)
- +24 IF '$DATA(FLG)
- SET LN=0
- FOR
- SET LN=$ORDER(^GMR(123,+GMRCO,40,GMRCDD,1,LN))
- IF LN=""!(LN?1A.E)
- QUIT
- SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^(LN,0)
- SET GMRCLNO=GMRCLNO+1
- +25 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=""
- SET $PIECE(^(0),"-",79)=""
- +26 SET GMRCLNO=GMRCLNO+1
- +27 QUIT
- End DoDot:2
- +28 QUIT
- End DoDot:1
- +29 SET GMRCSS=$SELECT($DATA(GMRCEDT(1)):GMRCEDT(1),1:$PIECE(^GMR(123,+GMRCO,0),"^",5)_U_$PIECE(^GMR(123.5,$PIECE(^GMR(123,+GMRCO,0),"^",5),0),U))
- +30 SET GMRCPROC=$SELECT($DATA(GMRCED(1)):GMRCED(1),1:$PIECE(^GMR(123,+GMRCO,0),"^",8)_U_$$GET1^DIQ(123.3,+$PIECE(^GMR(123,+GMRCO,0),"^",8),.01))
- +31 SET GMRCURG=$SELECT($DATA(GMRCED(3)):GMRCED(3),1:$PIECE(^GMR(123,+GMRCO,0),"^",9)_U_$$GET1^DIQ(101,+$PIECE(^(0),"^",9),1))
- +32 SET GMRCPL=$SELECT($DATA(GMRCED(4)):GMRCED(4),1:$PIECE(^GMR(123,+GMRCO,0),"^",10)_U_$$GET1^DIQ(101,+$PIECE(^(0),U,10),1))
- +33 SET GMRCATN=$SELECT($DATA(GMRCED(5)):GMRCED(5),1:$PIECE(^GMR(123,+GMRCO,0),"^",11)_U_$$GET1^DIQ(200,+$PIECE(^(0),U,11),.01))
- +34 IF '$DATA(^GMR(123,GMRCO,30.1))
- Begin DoDot:1
- +35 IF $DATA(GMRCED(6))
- IF $LENGTH($PIECE(GMRCED(6),U,2))
- Begin DoDot:2
- +36 SET GMRCDIAG=$PIECE(GMRCED(6),U)_" ("_$PIECE(GMRCED(6),U,2)_")"
- End DoDot:2
- QUIT
- +37 SET GMRCDIAG=$SELECT($DATA(GMRCED(6)):GMRCED(6),1:$GET(^GMR(123,+GMRCO,30)))
- End DoDot:1
- +38 IF $DATA(^GMR(123,GMRCO,30.1))
- Begin DoDot:1
- +39 IF $DATA(GMRCED(6))
- IF $LENGTH(GMRCED(6))
- Begin DoDot:2
- +40 SET GMRCDIAG=$PIECE(GMRCED(6),U)_" ("_$PIECE(GMRCED(6),U,2)_")"
- End DoDot:2
- QUIT
- +41 SET GMRCDIAG=$GET(^GMR(123,+GMRCO,30))
- +42 IF '$$STATCHK^ICDAPIU(^GMR(123,GMRCO,30.1),DT)
- Begin DoDot:2
- +43 SET GMRCDIAG=GMRCDIAG_" <INACTIVE CODE>"
- End DoDot:2
- End DoDot:1
- +44 IF $DATA(GMRCED(2))
- SET GMRCINO=GMRCED(2)
- +45 IF '$DATA(GMRCINO)
- SET GMRCINO=$PIECE(^GMR(123,+GMRCO,0),U,18)_U_$SELECT($PIECE(^(0),U,18)="I":"Inpatient",1:"Outpatient")
- +46 SET GMRCREQ=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),U,17)="P":"Procedure",1:"Consult")
- +47 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="SENDING PROVIDER (Not Editable): "_$SELECT($PIECE($GET(^GMR(123,+GMRCO,12)),U,6):$PIECE(^GMR(123,+GMRCO,12),U,6),$PIECE(^GMR(123,+GMRCO,0),"^",14):$$GET1^DIQ(200,+$PIECE(^GMR(123,+GMRCO,0),"^",14),.01),1:"
- UNKNOWN")
- SET GMRCLNO=GMRCLNO+1
- +48 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="REQUEST TYPE (Not Editable): "_GMRCREQ
- SET GMRCLNO=GMRCLNO+1
- +49 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=$$REPEAT^XLFSTR("-",79)
- SET GMRCLNO=GMRCLNO+1
- +50 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=" TO SERVICE (Not Editable): "_$PIECE(GMRCSS,U,2)
- SET GMRCLNO=GMRCLNO+1
- +51 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=" "
- SET GMRCLNO=GMRCLNO+1
- +52 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="1 PROCEDURE: "_$PIECE(GMRCPROC,U,2)
- +53 IF +GMRCPROC
- DO RVRS(GMRCLNO,$DATA(GMRCED(1)))
- SET GMRCLNO=GMRCLNO+1
- +54 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="2 Performed as INPT OR OUTPT: "_$PIECE(GMRCINO,U,2)
- DO RVRS(GMRCLNO,$DATA(GMRCED(2)))
- SET GMRCLNO=GMRCLNO+1
- +55 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="3 URGENCY: "_$PIECE(GMRCURG,U,2)
- DO RVRS(GMRCLNO,$DATA(GMRCED(3)))
- SET GMRCLNO=GMRCLNO+1
- +56 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="4 PLACE OF CONSULTATION: "_$PIECE(GMRCPL,U,2)
- DO RVRS(GMRCLNO,$DATA(GMRCED(4)))
- SET GMRCLNO=GMRCLNO+1
- +57 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="5 ATTENTION (CONSULTANT): "_$PIECE(GMRCATN,U,2)
- DO RVRS(GMRCLNO,$DATA(GMRCED(5)))
- SET GMRCLNO=GMRCLNO+1
- +58 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="6 PROVISIONAL DIAGNOSIS: "_GMRCDIAG
- DO RVRS(GMRCLNO,$DATA(GMRCED(6)))
- SET GMRCLNO=GMRCLNO+1
- +59 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="7 REASON FOR REQUEST:"
- DO RVRS(GMRCLNO,$DATA(^TMP("GMRCED",$JOB,20)))
- SET GMRCLNO=GMRCLNO+1
- Begin DoDot:1
- +60 IF $DATA(^TMP("GMRCED",$JOB,20))
- Begin DoDot:2
- +61 NEW ND
- SET ND=0
- +62 FOR
- SET ND=$ORDER(^TMP("GMRCED",$JOB,20,ND))
- IF 'ND
- QUIT
- Begin DoDot:3
- +63 DO KILL^VALM10(GMRCLNO)
- +64 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^TMP("GMRCED",$JOB,20,ND,0)
- +65 SET GMRCLNO=GMRCLNO+1
- End DoDot:3
- End DoDot:2
- QUIT
- +66 NEW ND
- SET ND=0
- +67 FOR
- SET ND=$ORDER(^GMR(123,+GMRCO,20,ND))
- IF ND=""
- QUIT
- Begin DoDot:2
- +68 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^GMR(123,+GMRCO,20,ND,0)
- +69 SET GMRCLNO=GMRCLNO+1
- End DoDot:2
- +70 QUIT
- End DoDot:1
- +71 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=""
- SET GMRCLNO=GMRCLNO+1
- SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="8 COMMENT(S): (Add Only)"
- DO RVRS(GMRCLNO)
- SET GMRCLNO=GMRCLNO+1
- +72 IF $DATA(^TMP("GMRCED",$JOB,40))
- Begin DoDot:1
- +73 DO KILL^VALM10(GMRCLNO)
- +74 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=" New Comment:"
- SET GMRCLNO=GMRCLNO+1
- +75 NEW ND
- SET ND=0
- FOR
- SET ND=$ORDER(^TMP("GMRCED",$JOB,40,ND))
- IF 'ND
- QUIT
- Begin DoDot:2
- +76 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^TMP("GMRCED",$JOB,40,ND,0)
- +77 SET GMRCLNO=GMRCLNO+1
- End DoDot:2
- End DoDot:1
- +78 NEW GMRCEDCT
- +79 SET GMRCD=0
- SET GMRCEDCT=0
- FOR
- SET GMRCD=$ORDER(^GMR(123,+GMRCO,40,"B",GMRCD))
- IF 'GMRCD
- QUIT
- SET GMRCDD=""
- SET GMRCDD=$ORDER(^GMR(123,+GMRCO,40,"B",GMRCD,GMRCDD))
- IF 'GMRCDD
- QUIT
- Begin DoDot:1
- +80 IF $PIECE(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=20
- SET LN=0
- SET GMRCEDCT=GMRCEDCT+1
- SET GMRCEDCM(GMRCEDCT)=GMRCDD
- Begin DoDot:2
- +81 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=""
- SET GMRCLNO=GMRCLNO+1
- SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)="ADDED COMMENT (Not Editable) Entered: "_$PIECE($$FMTE^XLFDT($PIECE(^GMR(123,+GMRCO,40,GMRCDD,0),"^",1)),"@",1)
- +82 SET GMRCRESP=$SELECT($LENGTH($PIECE($GET(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)):$PIECE(^VA(200,$PIECE(^GMR(123,+GMRCO,40,GMRCDD,0),"^",5),0),"^",1),$LENGTH(...
- ... $PIECE($GET(^GMR(123,+GMRCO,40,GMRCDD,2)),"^",1)):$PIECE(^GMR(123,+GMRCO,40,GMRCDD,2),"^",1),1:"UNKNOWN")
- +83 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)_" BY: "_GMRCRESP
- SET GMRCLNO=GMRCLNO+1
- +84 ;S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCR",$J,"ED",GMRCLNO,0)_" BY: "_$S($L($P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4)):$P(^VA(200,$P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4),0),"^",1),1:"UNKNOWN"),GMRCLNO=GMRCLNO+1
- +85 SET LN=$ORDER(^GMR(123,+GMRCO,40,GMRCDD,1,LN))
- IF LN=""!(LN?1A.E)
- QUIT
- IF $LENGTH(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75
- SET FLG=1
- DO WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG)
- QUIT
- +86 SET LN=0
- FOR
- SET LN=$ORDER(^GMR(123,+GMRCO,40,GMRCDD,1,LN))
- IF LN=""!(LN?1A.E)
- QUIT
- SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=^(LN,0)
- SET GMRCLNO=GMRCLNO+1
- +87 QUIT
- End DoDot:2
- +88 QUIT
- End DoDot:1
- +89 SET ^TMP("GMRCR",$JOB,"ED",GMRCLNO,0)=""
- +90 KILL FLG
- +91 QUIT
- RVRS(LINE,EDITED) ;reverse video for fields that can be edited
- +1 IF '$GET(EDITED)
- DO CNTRL^VALM10(LINE,1,1,IORVON,IORVOFF)
- QUIT
- +2 DO CNTRL^VALM10(LINE,1,1,IORVON_IOINHI,IORVOFF_IOINORM)
- +3 QUIT
