GMRCPRPS ;SLC/DCM - List Manager GMRC Routine -- List GMRC (Consults/Request) Protocols in abbreviated form. ;5/20/98 14:20
;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
ENL ;List Manager Entry Point
K ^TMP("GMRCR",$J,"PRS"),TMP
W !,"Building Report: Please Wait..."
S FILE="101",FIELDS=".01;1",FLAGS="EZ",TARGET="TMP",MSG="ERROR",TAB="",$P(TAB," ",30)=" ",GMRCCT=1,GMRCBXRF="GMRC"
F S GMRCBXRF=$O(^ORD(101,"B",GMRCBXRF)) Q:$E(GMRCBXRF,1,4)'["GMRC"!(GMRCBXRF="") S IENS=0,IENS=$O(^ORD(101,"B",GMRCBXRF,IENS)) D GETS^DIQ(FILE,IENS,FIELDS,FLAGS,"TMP","ERMSG") D
.S GMRCPNM=TMP(FILE,IENS_",",.01,"E"),GMRCTXT=TMP(FILE,IENS_",",1,"E")
.S ^TMP("GMRCR",$J,"PRS",GMRCCT,0)=$E(GMRCPNM,1,39)_" "_$E(TAB,1,39-$L(GMRCPNM))_$E(GMRCTXT,1,40),GMRCCT=GMRCCT+1
.K TMP Q
S GMRCCT=GMRCCT-1
QUIT ;Kill off variables
K ERMSG,FILE,FIELDS,FLAGS,TARGET,MSG,IENS,GMRCBXRF,GMRCPNM,GMRCTXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPRPS 898 printed Dec 13, 2024@01:46:51 Page 2
GMRCPRPS ;SLC/DCM - List Manager GMRC Routine -- List GMRC (Consults/Request) Protocols in abbreviated form. ;5/20/98 14:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
ENL ;List Manager Entry Point
+1 KILL ^TMP("GMRCR",$JOB,"PRS"),TMP
+2 WRITE !,"Building Report: Please Wait..."
+3 SET FILE="101"
SET FIELDS=".01;1"
SET FLAGS="EZ"
SET TARGET="TMP"
SET MSG="ERROR"
SET TAB=""
SET $PIECE(TAB," ",30)=" "
SET GMRCCT=1
SET GMRCBXRF="GMRC"
+4 FOR
SET GMRCBXRF=$ORDER(^ORD(101,"B",GMRCBXRF))
if $EXTRACT(GMRCBXRF,1,4)'["GMRC"!(GMRCBXRF="")
QUIT
SET IENS=0
SET IENS=$ORDER(^ORD(101,"B",GMRCBXRF,IENS))
DO GETS^DIQ(FILE,IENS,FIELDS,FLAGS,"TMP","ERMSG")
Begin DoDot:1
+5 SET GMRCPNM=TMP(FILE,IENS_",",.01,"E")
SET GMRCTXT=TMP(FILE,IENS_",",1,"E")
+6 SET ^TMP("GMRCR",$JOB,"PRS",GMRCCT,0)=$EXTRACT(GMRCPNM,1,39)_" "_$EXTRACT(TAB,1,39-$LENGTH(GMRCPNM))_$EXTRACT(GMRCTXT,1,40)
SET GMRCCT=GMRCCT+1
+7 KILL TMP
QUIT
End DoDot:1
+8 SET GMRCCT=GMRCCT-1
QUIT ;Kill off variables
+1 KILL ERMSG,FILE,FIELDS,FLAGS,TARGET,MSG,IENS,GMRCBXRF,GMRCPNM,GMRCTXT
+2 QUIT
