- 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
- 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