Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXPROUI

ECXPROUI.m

Go to the documentation of this file.
  1. ECXPROUI ;ALB/DAN - Display unit of issue records from file 420.5 ;3/6/17 15:25
  1. ;;3.0;DSS EXTRACTS;**166**;Dec 22, 1997;Build 24
  1. ;
  1. N ECXPORT,ZTSAVE
  1. W !!,"This report will list all units of issue that can be used in prosthetics.",!,"The list will include the 2 character name as well as the full name.",!
  1. S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1
  1. I $G(ECXPORT) D Q ;If exporting get records and display to screen
  1. .K ^TMP($J,"ECXPROUI"),^TMP($J,"ECXPORT")
  1. .D GETUNITS
  1. .M ^TMP($J,"ECXPORT")=^TMP($J,"ECXPROUI")
  1. .S ^TMP($J,"ECXPORT",0)="NAME^FULL NAME"
  1. .D EXPDISP^ECXUTL1
  1. .K ^TMP($J,"ECXPROUI"),^TMP($J,"ECXPORT")
  1. .Q
  1. ;
  1. D EN^XUTMDEVQ("START^ECXPROUI","Print unit of issue entries from file 420.5",.ZTSAVE)
  1. Q
  1. ;
  1. START ;
  1. K ^TMP($J,"ECXPROUI")
  1. D GETUNITS
  1. D PRINT
  1. K ^TMP($J,"ECXPROUI")
  1. Q
  1. ;
  1. GETUNITS ;Get unit of issue
  1. N CNT,NAME,IEN,NODE
  1. S CNT=0
  1. S NAME="" F S NAME=$O(^PRCD(420.5,"B",NAME)) Q:NAME="" S IEN=0 F S IEN=$O(^PRCD(420.5,"B",NAME,IEN)) Q:'+IEN D
  1. .Q:$L(NAME)'=2 ;Stop if name isn't in correct form
  1. .S NODE=$G(^PRCD(420.5,IEN,0)) Q:NODE="" ;if node doesn't exist, problem with "B" cross reference
  1. .S CNT=CNT+1,^TMP($J,"ECXPROUI",CNT)=NAME_"^"_$P(NODE,U,2)
  1. .Q
  1. Q
  1. ;
  1. PRINT ;Display results
  1. N NUM,DATA,PAGE,RDAT,QFLG
  1. S (PAGE,QFLG)=0,RDAT=$$FMTE^XLFDT($E($$NOW^XLFDT,1,12))
  1. D HEAD
  1. S NUM=0 F S NUM=$O(^TMP($J,"ECXPROUI",NUM)) Q:'+NUM!(QFLG) D
  1. .I $Y>($G(IOSL)-4) D HEAD Q:QFLG
  1. .S DATA=^TMP($J,"ECXPROUI",NUM)
  1. .W !,$P(DATA,"^"),?5,$P(DATA,"^",2)
  1. .Q
  1. Q
  1. ;
  1. N Y,DIR
  1. I $E(IOST)="C",PAGE>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
  1. W @IOF
  1. S PAGE=PAGE+1
  1. W "Unit of Issue List on ",RDAT,?70,"Page: ",PAGE,!
  1. W !,"NAME",?5,"FULL NAME",!,$$REPEAT^XLFSTR("-",80)
  1. Q