- GMRCSTL2 ;SLC/DCM,dee;MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;4/18/01 10:31
- ;;3.0;CONSULT/REQUEST TRACKING;**7,21,22,63**;DEC 27, 1997;Build 10
- ; Patch #21 changed array GMRCTOT to ^TMP("GMRCTOT",$J)
- ; Patch #21 also added a plus sign to the $P when setting
- ; GMRCDLA to check for a NULL value.
- ; This routine invokes IA #10035,#44, #10040
- Q
- ;
- ONESTAT(GMRCARRN) ;Process one status
- ; Input -- GMRCARRN List Template Array Name (Subscript)
- ; Values:
- ; "CP": pending consults; "IFC": inter-facility consults
- ; Output - None
- S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=0
- S ^TMP("GMRCTOT",$J,2,GMRCSVC,STATUS)=0
- S GMRCXDT=$S(GMRCDT1="ALL":0,1:9999999-GMRCDT2-.6)
- F S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-GMRCDT1)) D
- .S GMRCPT=0
- ONE .;Loop for one consult at a time
- .F S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)) Q:GMRCPT="" D
- ..; Check for bad "AE" x-ref
- ..I '$D(^GMR(123,GMRCPT,0)) D Q
- ...K ^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)
- ..S X=9999999-GMRCXDT
- ..D REGDTM^GMRCU
- ..S GMRCDT=$P(X," ",1)
- ..S GMRCDLA=$P(X," ",1)
- ..S GMRCD(0)=^GMR(123,GMRCPT,0)
- ..I GMRCARRN="IFC" D Q:'GMRCCK
- ...S GMRCCK=1
- ...S:'$D(GMRCIS) GMRCCK=0 S:'$P($G(GMRCD(0)),"^",23) GMRCCK=0
- ...I GMRCCK=1 D
- ....S GMRCD(12)=$G(^GMR(123,GMRCPT,12))
- ....I GMRCIS="R",$P(GMRCD(12),"^",5)'="P" S GMRCCK=0
- ....I GMRCIS="C",$P(GMRCD(12),"^",5)'="F" S GMRCCK=0
- ....I $D(GMRCREMP),$P(GMRCD(12),"^",6)'=GMRCREMP S GMRCCK=0
- ....I $D(GMRCRF),$P($G(GMRCD(0)),"^",23)'=GMRCRF S GMRCCK=0
- ..S GMRCPTN=$P(^DPT($P(GMRCD(0),"^",2),0),"^",1)
- ..S GMRCPTN=$P(GMRCPTN,",",1)_","_$E($P(GMRCPTN,",",2),1)_"."
- ..S GMRCPTSN="("_$E($P(^DPT($P(GMRCD(0),"^",2),0),"^",9),6,9)_")"
- ..; IF Consults
- ..I GMRCARRN="IFC" D
- ...N GMRCIRF,RCVDT,COMPLDT,ND
- ...S GMRCIRFN="NONE",GMRCIDD="N/A",GMRCRDT=""
- ...S GMRCIRF=$P($G(GMRCD(0)),"^",23)
- ... I GMRCIRF S GMRCIRFN=$E($$GET1^DIQ(4,GMRCIRF,.01),1,16)
- ...I '$D(^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)) D
- ....S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=0
- ....S GMRCST(1,GMRCSVC,GMRCIRFN)="0^0"
- ...D GETDT^GMRCSTU(GMRCPT)
- ...I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
- ....S X1=COMPLDT,X2=RCVDT D ^%DTC
- ....S GMRCIDD=X
- ...I GMRCIS="C" D
- ....S GMRCRDT=$$GETRDT(GMRCPT)
- ....I GMRCRDT]"" D
- .....N X
- .....S X=GMRCRDT D REGDT^GMRCU
- .....S GMRCRDT=X
- ..S GMRCD=0
- ..S GMRCD=$O(^GMR(123,GMRCPT,40,"B",GMRCD))
- ..I GMRCD]"" D
- ...S GMRCDA=""
- ...S GMRCDA=$O(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA))
- ..S GMRCDLA=$E($P($G(^GMR(123.1,+$P(GMRCD(0),"^",13),0)),"^"),1,19)
- ..S GMRCLOC=$P(GMRCD(0),"^",4)
- ..S:$L(GMRCLOC) GMRCLOC=$P($G(^SC(GMRCLOC,0)),"^",1) ;DBIA#10040
- ..I '$L(GMRCLOC),$P(GMRCD(0),U,21) D
- ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,21),.01)
- ..I '$L(GMRCLOC),$P(GMRCD(0),U,23) D
- ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,23),.01)
- ..I GMRCARRN="IFC",$L(GMRCLOC) D
- ...S GMRCLOC=$E(GMRCLOC,1,23)
- ..I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0 D
- ...S GMRCCT=GMRCCT+1
- ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
- ...S GMRCCT=GMRCCT+1
- ...S TEMP="SERVICE: "_GMRCSVCP
- ...S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
- ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_TEMP
- ...S NUMCLIN=NUMCLIN+1
- ..S LINETEMP=""
- CTRL ..I GMRCCTRL#100\10 D
- ...I GMRCCTRL#100\10=1 D
- ....S GMRCLINE=GMRCLINE+1
- ....S ^TMP("GMRCRINDEX",$J,GMRCLINE)=GMRCPT
- ....S LINETEMP=$J(GMRCLINE,4)_" "
- ...E S LINETEMP=$J(GMRCPT,9)_" "
- ..I GMRCCTRL#2 S LINETEMP=GMRCPT_"^"_LINETEMP
- ..I GMRCCTRL#1000\100 D
- ...S STS=$$STATABBR^GMRCSTL1(STATUS)
- ...S STS=STS_$J("",4-$L(STS)+1)
- ..E D
- ...S STS=$$STATNAME^GMRCSTL1(STATUS)
- ...S STS=STS_$J("",10-$L(STS)+1)
- ..S GMRCCT=GMRCCT+1
- ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=LINETEMP_STS_GMRCDLA_$J("",20-$L(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$J("",12-$L(GMRCPTN)+5)_GMRCLOC
- ..; IF Consults
- ..I GMRCARRN="IFC" D
- ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)_$J("",25-$L(GMRCLOC))_GMRCIRFN_$J("",17-$L(GMRCIRFN))_" "_GMRCIDD_$J("",9-$L(GMRCIDD))_" "_GMRCRDT
- ...I '$D(GMRCCNSLT(GMRCPT)) S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)+1,GMRCCNSLT(GMRCPT)=""
- ...I GMRCIDD'="N/A" D
- ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")+GMRCIDD
- ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)+1
- ....S $P(GMRCST(1,GMRCSVC),"^")=$P(GMRCST(1,GMRCSVC),"^")+GMRCIDD
- ....S $P(GMRCST(1,GMRCSVC),"^",2)=$P(GMRCST(1,GMRCSVC),"^",2)+1
- ..;
- ADDTOT ..;Add to totals
- ..; for all status for this service
- ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=^TMP("GMRCTOT",$J,1,GMRCSVC,"T")+1
- ..; pending for this service
- ..S:",3,4,5,6,8,9,11,99,"[(","_STATUS_",") ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=^TMP("GMRCTOT",$J,1,GMRCSVC,"P")+1
- ..; this status (STATUS) for this service
- ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)+1
- ..; this status (STATUS) for services to all of its groupers
- F GRP=GROUPER:-1:1 D
- . I $D(^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,STATUS)) Q
- . S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS)=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS))+^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS),^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,STATUS)=""
- Q
- ;
- GETRDT(GMRCPT) ;get the received date
- ; Input:
- ; GMRCPT = File #123 IEN
- ; Output:
- ; GMRCRDT = Date of action entry for remote request received/received
- N GMRCCKR,GMRCRDT,ND
- S (GMRCCKR,ND)=0,GMRCRDT=""
- F S ND=$O(^GMR(123,GMRCPT,40,ND)) Q:ND'>0!GMRCCKR D
- .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=23 D
- ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^"),GMRCCKR=1
- .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=21 D
- ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^")
- Q GMRCRDT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTL2 5944 printed Feb 18, 2025@23:13:44 Page 2
- GMRCSTL2 ;SLC/DCM,dee;MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;4/18/01 10:31
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**7,21,22,63**;DEC 27, 1997;Build 10
- +2 ; Patch #21 changed array GMRCTOT to ^TMP("GMRCTOT",$J)
- +3 ; Patch #21 also added a plus sign to the $P when setting
- +4 ; GMRCDLA to check for a NULL value.
- +5 ; This routine invokes IA #10035,#44, #10040
- +6 QUIT
- +7 ;
- ONESTAT(GMRCARRN) ;Process one status
- +1 ; Input -- GMRCARRN List Template Array Name (Subscript)
- +2 ; Values:
- +3 ; "CP": pending consults; "IFC": inter-facility consults
- +4 ; Output - None
- +5 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,STATUS)=0
- +6 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,STATUS)=0
- +7 SET GMRCXDT=$SELECT(GMRCDT1="ALL":0,1:9999999-GMRCDT2-.6)
- +8 FOR
- SET GMRCXDT=$ORDER(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT))
- if GMRCXDT=""!(GMRCXDT>(9999999-GMRCDT1))
- QUIT
- Begin DoDot:1
- +9 SET GMRCPT=0
- ONE ;Loop for one consult at a time
- +1 FOR
- SET GMRCPT=$ORDER(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT))
- if GMRCPT=""
- QUIT
- Begin DoDot:2
- +2 ; Check for bad "AE" x-ref
- +3 IF '$DATA(^GMR(123,GMRCPT,0))
- Begin DoDot:3
- +4 KILL ^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)
- End DoDot:3
- QUIT
- +5 SET X=9999999-GMRCXDT
- +6 DO REGDTM^GMRCU
- +7 SET GMRCDT=$PIECE(X," ",1)
- +8 SET GMRCDLA=$PIECE(X," ",1)
- +9 SET GMRCD(0)=^GMR(123,GMRCPT,0)
- +10 IF GMRCARRN="IFC"
- Begin DoDot:3
- +11 SET GMRCCK=1
- +12 if '$DATA(GMRCIS)
- SET GMRCCK=0
- if '$PIECE($GET(GMRCD(0)),"^",23)
- SET GMRCCK=0
- +13 IF GMRCCK=1
- Begin DoDot:4
- +14 SET GMRCD(12)=$GET(^GMR(123,GMRCPT,12))
- +15 IF GMRCIS="R"
- IF $PIECE(GMRCD(12),"^",5)'="P"
- SET GMRCCK=0
- +16 IF GMRCIS="C"
- IF $PIECE(GMRCD(12),"^",5)'="F"
- SET GMRCCK=0
- +17 IF $DATA(GMRCREMP)
- IF $PIECE(GMRCD(12),"^",6)'=GMRCREMP
- SET GMRCCK=0
- +18 IF $DATA(GMRCRF)
- IF $PIECE($GET(GMRCD(0)),"^",23)'=GMRCRF
- SET GMRCCK=0
- End DoDot:4
- End DoDot:3
- if 'GMRCCK
- QUIT
- +19 SET GMRCPTN=$PIECE(^DPT($PIECE(GMRCD(0),"^",2),0),"^",1)
- +20 SET GMRCPTN=$PIECE(GMRCPTN,",",1)_","_$EXTRACT($PIECE(GMRCPTN,",",2),1)_"."
- +21 SET GMRCPTSN="("_$EXTRACT($PIECE(^DPT($PIECE(GMRCD(0),"^",2),0),"^",9),6,9)_")"
- +22 ; IF Consults
- +23 IF GMRCARRN="IFC"
- Begin DoDot:3
- +24 NEW GMRCIRF,RCVDT,COMPLDT,ND
- +25 SET GMRCIRFN="NONE"
- SET GMRCIDD="N/A"
- SET GMRCRDT=""
- +26 SET GMRCIRF=$PIECE($GET(GMRCD(0)),"^",23)
- +27 IF GMRCIRF
- SET GMRCIRFN=$EXTRACT($$GET1^DIQ(4,GMRCIRF,.01),1,16)
- +28 IF '$DATA(^TMP("GMRCTOT",$JOB,1,GMRCSVC,"F",GMRCIRFN))
- Begin DoDot:4
- +29 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"F",GMRCIRFN)=0
- +30 SET GMRCST(1,GMRCSVC,GMRCIRFN)="0^0"
- End DoDot:4
- +31 DO GETDT^GMRCSTU(GMRCPT)
- +32 IF COMPLDT<9999999
- IF $SELECT(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0)
- Begin DoDot:4
- +33 SET X1=COMPLDT
- SET X2=RCVDT
- DO ^%DTC
- +34 SET GMRCIDD=X
- End DoDot:4
- +35 IF GMRCIS="C"
- Begin DoDot:4
- +36 SET GMRCRDT=$$GETRDT(GMRCPT)
- +37 IF GMRCRDT]""
- Begin DoDot:5
- +38 NEW X
- +39 SET X=GMRCRDT
- DO REGDT^GMRCU
- +40 SET GMRCRDT=X
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +41 SET GMRCD=0
- +42 SET GMRCD=$ORDER(^GMR(123,GMRCPT,40,"B",GMRCD))
- +43 IF GMRCD]""
- Begin DoDot:3
- +44 SET GMRCDA=""
- +45 SET GMRCDA=$ORDER(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA))
- End DoDot:3
- +46 SET GMRCDLA=$EXTRACT($PIECE($GET(^GMR(123.1,+$PIECE(GMRCD(0),"^",13),0)),"^"),1,19)
- +47 SET GMRCLOC=$PIECE(GMRCD(0),"^",4)
- +48 ;DBIA#10040
- if $LENGTH(GMRCLOC)
- SET GMRCLOC=$PIECE($GET(^SC(GMRCLOC,0)),"^",1)
- +49 IF '$LENGTH(GMRCLOC)
- IF $PIECE(GMRCD(0),U,21)
- Begin DoDot:3
- +50 SET GMRCLOC=$$GET1^DIQ(4,$PIECE(GMRCD(0),U,21),.01)
- End DoDot:3
- +51 IF '$LENGTH(GMRCLOC)
- IF $PIECE(GMRCD(0),U,23)
- Begin DoDot:3
- +52 SET GMRCLOC=$$GET1^DIQ(4,$PIECE(GMRCD(0),U,23),.01)
- End DoDot:3
- +53 IF GMRCARRN="IFC"
- IF $LENGTH(GMRCLOC)
- Begin DoDot:3
- +54 SET GMRCLOC=$EXTRACT(GMRCLOC,1,23)
- End DoDot:3
- +55 IF ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")=0
- Begin DoDot:3
- +56 SET GMRCCT=GMRCCT+1
- +57 SET ^TMP("GMRCR",$JOB,GMRCARRN,GMRCCT,0)=CTRLTEMP
- +58 SET GMRCCT=GMRCCT+1
- +59 SET TEMP="SERVICE: "_GMRCSVCP
- +60 if GMRCSVCG>0
- SET TEMP=TEMP_" in Group: "_$PIECE(^GMR(123.5,GMRCSVCG,0),"^",1)
- +61 SET ^TMP("GMRCR",$JOB,GMRCARRN,GMRCCT,0)=CTRLTEMP_TEMP
- +62 SET NUMCLIN=NUMCLIN+1
- End DoDot:3
- +63 SET LINETEMP=""
- CTRL IF GMRCCTRL#100\10
- Begin DoDot:3
- +1 IF GMRCCTRL#100\10=1
- Begin DoDot:4
- +2 SET GMRCLINE=GMRCLINE+1
- +3 SET ^TMP("GMRCRINDEX",$JOB,GMRCLINE)=GMRCPT
- +4 SET LINETEMP=$JUSTIFY(GMRCLINE,4)_" "
- End DoDot:4
- +5 IF '$TEST
- SET LINETEMP=$JUSTIFY(GMRCPT,9)_" "
- End DoDot:3
- +6 IF GMRCCTRL#2
- SET LINETEMP=GMRCPT_"^"_LINETEMP
- +7 IF GMRCCTRL#1000\100
- Begin DoDot:3
- +8 SET STS=$$STATABBR^GMRCSTL1(STATUS)
- +9 SET STS=STS_$JUSTIFY("",4-$LENGTH(STS)+1)
- End DoDot:3
- +10 IF '$TEST
- Begin DoDot:3
- +11 SET STS=$$STATNAME^GMRCSTL1(STATUS)
- +12 SET STS=STS_$JUSTIFY("",10-$LENGTH(STS)+1)
- End DoDot:3
- +13 SET GMRCCT=GMRCCT+1
- +14 SET ^TMP("GMRCR",$JOB,GMRCARRN,GMRCCT,0)=LINETEMP_STS_GMRCDLA_$JUSTIFY("",20-$LENGTH(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$JUSTIFY("",12-$LENGTH(GMRCPTN)+5)_GMRCLOC
- +15 ; IF Consults
- +16 IF GMRCARRN="IFC"
- Begin DoDot:3
- +17 SET ^TMP("GMRCR",$JOB,GMRCARRN,GMRCCT,0)=^TMP("GMRCR",$JOB,GMRCARRN,GMRCCT,0)_$JUSTIFY("",25-$LENGTH(GMRCLOC))_GMRCIRFN_$JUSTIFY("",17-$LENGTH(GMRCIRFN))_" "_GMRCIDD_$JUSTIFY("",9-$LENGTH(GMRCIDD))_" "_GMRCRDT
- +18 IF '$DATA(GMRCCNSLT(GMRCPT))
- SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"F",GMRCIRFN)=^TMP("GMRCTOT",$JOB,1,GMRCSVC,"F",GMRCIRFN)+1
- SET GMRCCNSLT(GMRCPT)=""
- +19 IF GMRCIDD'="N/A"
- Begin DoDot:4
- +20 SET $PIECE(GMRCST(1,GMRCSVC,GMRCIRFN),"^")=$PIECE(GMRCST(1,GMRCSVC,GMRCIRFN),"^")+GMRCIDD
- +21 SET $PIECE(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)=$PIECE(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)+1
- +22 SET $PIECE(GMRCST(1,GMRCSVC),"^")=$PIECE(GMRCST(1,GMRCSVC),"^")+GMRCIDD
- +23 SET $PIECE(GMRCST(1,GMRCSVC),"^",2)=$PIECE(GMRCST(1,GMRCSVC),"^",2)+1
- End DoDot:4
- End DoDot:3
- +24 ;
- ADDTOT ;Add to totals
- +1 ; for all status for this service
- +2 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")=^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")+1
- +3 ; pending for this service
- +4 if ",3,4,5,6,8,9,11,99,"[(","_STATUS_",")
- SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")=^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")+1
- +5 ; this status (STATUS) for this service
- +6 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,STATUS)=^TMP("GMRCTOT",$JOB,1,GMRCSVC,STATUS)+1
- +7 ; this status (STATUS) for services to all of its groupers
- End DoDot:2
- End DoDot:1
- +8 FOR GRP=GROUPER:-1:1
- Begin DoDot:1
- +9 IF $DATA(^TMP("GMRCTOTX",$JOB,GROUPER(GRP),GMRCSVC,STATUS))
- QUIT
- +10 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),STATUS)=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),STATUS))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,STATUS)
- SET ^TMP("GMRCTOTX",$JOB,GROUPER(GRP),GMRCSVC,STATUS)=""
- End DoDot:1
- +11 QUIT
- +12 ;
- GETRDT(GMRCPT) ;get the received date
- +1 ; Input:
- +2 ; GMRCPT = File #123 IEN
- +3 ; Output:
- +4 ; GMRCRDT = Date of action entry for remote request received/received
- +5 NEW GMRCCKR,GMRCRDT,ND
- +6 SET (GMRCCKR,ND)=0
- SET GMRCRDT=""
- +7 FOR
- SET ND=$ORDER(^GMR(123,GMRCPT,40,ND))
- if ND'>0!GMRCCKR
- QUIT
- Begin DoDot:1
- +8 IF $PIECE(^GMR(123,GMRCPT,40,ND,0),"^",2)=23
- Begin DoDot:2
- +9 SET GMRCRDT=$PIECE(^GMR(123,GMRCPT,40,ND,0),"^")
- SET GMRCCKR=1
- End DoDot:2
- +10 IF $PIECE(^GMR(123,GMRCPT,40,ND,0),"^",2)=21
- Begin DoDot:2
- +11 SET GMRCRDT=$PIECE(^GMR(123,GMRCPT,40,ND,0),"^")
- End DoDot:2
- End DoDot:1
- +12 QUIT GMRCRDT