- GMRCPRP ;SLC/DCM - Set protocol information into ^TMP global for print and display by List Manager ;5/20/98 14:20
- ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- ENL ;;List manager entry point
- W !,"Compiling Report: Please Wait..."
- EN ;Entry point
- K ^TMP("GMRCR",$J,"PRL"),ERMSG
- S FILE="101",FIELDS=".01;1;1.1;1.11;3.5;4;6;10*;12",FLAGS="EZ",TARGET="TMP",MSG="ERROR",TAB="",$P(TAB," ",50)="",GMRCCT=1
- S GMRCBXRF="GMRC"
- F S GMRCBXRF=$O(^ORD(101,"B",GMRCBXRF)) Q:GMRCBXRF'["GMRC"!(GMRCBXRF="") W "." S IENS=0,IENS=$O(^ORD(101,"B",GMRCBXRF,IENS)) D GETS^DIQ(FILE,IENS,FIELDS,FLAGS,"TMP","ERMSG") D
- .S GMRCPRNM=$E(TMP(FILE,IENS_",",.01,"E"),1,39),GMRCTXT=$S($D(TMP(FILE,IENS_",",1,"E")):$E(TMP(FILE,IENS_",",1,"E"),1,39),1:"")
- .S GMRCSYN=$S($D(TMP(FILE,IENS_",",1.1,"E")):TMP(FILE,IENS_",",1.1,"E"),1:""),GMRCPKG=$S($D(TMP(FILE,IENS_",",12,"E")):TMP(FILE,IENS_",",12,"E"),1:"")
- .S GMRCTYP=$S($D(TMP(FILE,IENS_",",4,"E")):TMP(FILE,IENS_",",4,"E"),1:"")
- .S GMRCFILK=$S($D(TMP(FILE,IENS_",",6,"E")):TMP(FILE,IENS_",",6,"E"),1:"")
- .S GMRCNM=$S($D(TMP(FILE,IENS_",",1.11,"E")):TMP(FILE,IENS_",",1.11,"E"),1:"")
- .S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=GMRCPRNM_$E(TAB,1,40-$L(GMRCPRNM))_$E(GMRCTXT,1,39),GMRCCT=GMRCCT+1,^TMP("GMRCR",$J,"PRL",GMRCCT,0)="Type:"_$E(TAB,1,8)_GMRCTYP_$E(TAB,1,27-$L(GMRCTYP))_"Print Name: "_GMRCNM,GMRCCT=GMRCCT+1
- .S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)="Package:"_$E(TAB,1,5)_GMRCPKG_$E(TAB,1,27-$L(GMRCPKG))_"File Link: "_GMRCFILK,GMRCCT=GMRCCT+1
- .I $O(TMP(FILE,IENS_",",3.5,0))?1N.N S GLOB="TMP("_FILE_","""_IENS_","""_",3.5)" D
- ..S LINE="Description: " D WPSET^GMRCUTIL(GLOB,"^TMP(""GMRCR"",$J,""PRL"")",LINE,.GMRCCT,TAB,1)
- ..Q
- .I $O(TMP(FILE,IENS_",",3.5,0))="E" S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)="Description:",GMRCCT=GMRCCT+1
- .S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)="Synonyms:"_$E(TAB,1,13)_$S($D(TMP(FILE,IENS_",",1.1,"E")):TMP(FILE,IENS_",",1.1,"E"),1:""),GMRCCT=GMRCCT+1
- .I $O(TMP(FILE_".01",""))="" S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)="Menu Items:",GMRCCT=GMRCCT+1
- .I $O(TMP(FILE_".01",""))]"" S GMRCSUB="",GMRCITM="Menu Items: " F S GMRCSUB=$O(TMP(FILE_".01",GMRCSUB)) Q:GMRCSUB="" D
- ..I $D(TMP(FILE_".01",GMRCSUB,.01,"E")) S GMRCITM=$S('$L(GMRCITM):$E(TAB,1,13)_GMRCITM,1:GMRCITM)_TMP(FILE_".01",GMRCSUB,.01,"E"),GMRCMNE=TMP(FILE_".01",GMRCSUB,2,"E"),GMRCNO=$J(TMP(FILE_".01",GMRCSUB,3,"E"),3,0)
- ..I '$D(TMP(FILE_".01",GMRCSUB,.01,"E")),$L($O(ERMSG(0))) S GMRCITM=$E(TAB,1,13)_"Deleted Protocol: "_$G(ERMSG("DIERR",2,"PARAM",1)) K ERRMSG
- ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(GMRCITM_TAB,1,45)_GMRCNO_" "_GMRCMNE,GMRCCT=GMRCCT+1,GMRCITM=""
- ..Q
- .K TMP S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)="",GMRCCT=GMRCCT+1
- .Q
- S GMRCCT=GMRCCT-1
- QUIT ;Kill off local globals and exit
- K CNT,FLG,LNO,LN1,IENS,FILE,FLAGS,FIELDS,GLOB,LINE,ERMSG,GMRCNM,GMRCNO,GMRCND,GMRCSYN,GMRCITM,GMRCMNE,GMRCPKG,GMRCSUB,GMRCFILK,GMRCTXT,GMRCTYP,GMRDCFLN,GMRCBXRF,GMRCPRNM,TARGET
- Q
- GMRCPRP ;SLC/DCM - Set protocol information into ^TMP global for print and display by List Manager ;5/20/98 14:20
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- ENL ;;List manager entry point
- +1 WRITE !,"Compiling Report: Please Wait..."
- EN ;Entry point
- +1 KILL ^TMP("GMRCR",$JOB,"PRL"),ERMSG
- +2 SET FILE="101"
- SET FIELDS=".01;1;1.1;1.11;3.5;4;6;10*;12"
- SET FLAGS="EZ"
- SET TARGET="TMP"
- SET MSG="ERROR"
- SET TAB=""
- SET $PIECE(TAB," ",50)=""
- SET GMRCCT=1
- +3 SET GMRCBXRF="GMRC"
- +4 FOR
- SET GMRCBXRF=$ORDER(^ORD(101,"B",GMRCBXRF))
- IF GMRCBXRF'["GMRC"!(GMRCBXRF="")
- QUIT
- WRITE "."
- 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 GMRCPRNM=$EXTRACT(TMP(FILE,IENS_",",.01,"E"),1,39)
- SET GMRCTXT=$SELECT($DATA(TMP(FILE,IENS_",",1,"E")):$EXTRACT(TMP(FILE,IENS_",",1,"E"),1,39),1:"")
- +6 SET GMRCSYN=$SELECT($DATA(TMP(FILE,IENS_",",1.1,"E")):TMP(FILE,IENS_",",1.1,"E"),1:"")
- SET GMRCPKG=$SELECT($DATA(TMP(FILE,IENS_",",12,"E")):TMP(FILE,IENS_",",12,"E"),1:"")
- +7 SET GMRCTYP=$SELECT($DATA(TMP(FILE,IENS_",",4,"E")):TMP(FILE,IENS_",",4,"E"),1:"")
- +8 SET GMRCFILK=$SELECT($DATA(TMP(FILE,IENS_",",6,"E")):TMP(FILE,IENS_",",6,"E"),1:"")
- +9 SET GMRCNM=$SELECT($DATA(TMP(FILE,IENS_",",1.11,"E")):TMP(FILE,IENS_",",1.11,"E"),1:"")
- +10 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=GMRCPRNM_$EXTRACT(TAB,1,40-$LENGTH(GMRCPRNM))_$EXTRACT(GMRCTXT,1,39)
- SET GMRCCT=GMRCCT+1
- SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)="Type:"_$EXTRACT(TAB,1,8)_GMRCTYP_$EXTRACT(TAB,1,27-$LENGTH(GMRCTYP))_"Print Name: "_GMRCNM
- SET GMRCCT=GMRCCT+1
- +11 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)="Package:"_$EXTRACT(TAB,1,5)_GMRCPKG_$EXTRACT(TAB,1,27-$LENGTH(GMRCPKG))_"File Link: "_GMRCFILK
- SET GMRCCT=GMRCCT+1
- +12 IF $ORDER(TMP(FILE,IENS_",",3.5,0))?1N.N
- SET GLOB="TMP("_FILE_","""_IENS_","""_",3.5)"
- Begin DoDot:2
- +13 SET LINE="Description: "
- DO WPSET^GMRCUTIL(GLOB,"^TMP(""GMRCR"",$J,""PRL"")",LINE,.GMRCCT,TAB,1)
- +14 QUIT
- End DoDot:2
- +15 IF $ORDER(TMP(FILE,IENS_",",3.5,0))="E"
- SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)="Description:"
- SET GMRCCT=GMRCCT+1
- +16 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)="Synonyms:"_$EXTRACT(TAB,1,13)_$SELECT($DATA(TMP(FILE,IENS_",",1.1,"E")):TMP(FILE,IENS_",",1.1,"E"),1:"")
- SET GMRCCT=GMRCCT+1
- +17 IF $ORDER(TMP(FILE_".01",""))=""
- SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)="Menu Items:"
- SET GMRCCT=GMRCCT+1
- +18 IF $ORDER(TMP(FILE_".01",""))]""
- SET GMRCSUB=""
- SET GMRCITM="Menu Items: "
- FOR
- SET GMRCSUB=$ORDER(TMP(FILE_".01",GMRCSUB))
- IF GMRCSUB=""
- QUIT
- Begin DoDot:2
- +19 IF $DATA(TMP(FILE_".01",GMRCSUB,.01,"E"))
- SET GMRCITM=$SELECT('$LENGTH(GMRCITM):$EXTRACT(TAB,1,13)_GMRCITM,1:GMRCITM)_TMP(FILE_".01",GMRCSUB,.01,"E")
- SET GMRCMNE=TMP(FILE_".01",GMRCSUB,2,"E")
- SET GMRCNO=$JUSTIFY(TMP(FILE_".01",GMRCSUB,3,"E"),3,0)
- +20 IF '$DATA(TMP(FILE_".01",GMRCSUB,.01,"E"))
- IF $LENGTH($ORDER(ERMSG(0)))
- SET GMRCITM=$EXTRACT(TAB,1,13)_"Deleted Protocol: "_$GET(ERMSG("DIERR",2,"PARAM",1))
- KILL ERRMSG
- +21 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=$EXTRACT(GMRCITM_TAB,1,45)_GMRCNO_" "_GMRCMNE
- SET GMRCCT=GMRCCT+1
- SET GMRCITM=""
- +22 QUIT
- End DoDot:2
- +23 KILL TMP
- SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=""
- SET GMRCCT=GMRCCT+1
- +24 QUIT
- End DoDot:1
- +25 SET GMRCCT=GMRCCT-1
- QUIT ;Kill off local globals and exit
- +1 KILL CNT,FLG,LNO,LN1,IENS,FILE,FLAGS,FIELDS,GLOB,LINE,ERMSG,GMRCNM,GMRCNO,GMRCND,GMRCSYN,GMRCITM,GMRCMNE,GMRCPKG,GMRCSUB,GMRCFILK,GMRCTXT,GMRCTYP,GMRDCFLN,GMRCBXRF,GMRCPRNM,TARGET
- +2 QUIT
