PSN4PRE ;BIR/DMA-pre transport routine to get conversion values ;21 Sep 98 / 7:50 AM
;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
;
N ROOT,DA,I,K,X,LINE
S ROOT=$NA(@XPDGREF@("LINE")),DA=0,I=1,LINE="",TOT=0
F S DA=$O(^ZCONV(DA)),K=0 Q:'DA F S K=$O(^ZCONV(DA,K)) Q:'K S X=^(K),LINE=LINE_DA_"^"_K_"^"_X_"|" I $L(LINE)>200 S @ROOT@(I)=LINE,I=I+1,LINE=""
I $L(LINE) S @ROOT@(I)=LINE,I=I+1
;
;
S ROOT=$NA(@XPDGREF@("INTER")),DA=0
F S DA=$O(^PS(56,DA)) Q:'DA S X=^(DA,0),@ROOT@(DA)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN4PRE 501 printed Dec 13, 2024@02:22:21 Page 2
PSN4PRE ;BIR/DMA-pre transport routine to get conversion values ;21 Sep 98 / 7:50 AM
+1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
+2 ;
+3 NEW ROOT,DA,I,K,X,LINE
+4 SET ROOT=$NAME(@XPDGREF@("LINE"))
SET DA=0
SET I=1
SET LINE=""
SET TOT=0
+5 FOR
SET DA=$ORDER(^ZCONV(DA))
SET K=0
if 'DA
QUIT
FOR
SET K=$ORDER(^ZCONV(DA,K))
if 'K
QUIT
SET X=^(K)
SET LINE=LINE_DA_"^"_K_"^"_X_"|"
IF $LENGTH(LINE)>200
SET @ROOT@(I)=LINE
SET I=I+1
SET LINE=""
+6 IF $LENGTH(LINE)
SET @ROOT@(I)=LINE
SET I=I+1
+7 ;
+8 ;
+9 SET ROOT=$NAME(@XPDGREF@("INTER"))
SET DA=0
+10 FOR
SET DA=$ORDER(^PS(56,DA))
if 'DA
QUIT
SET X=^(DA,0)
SET @ROOT@(DA)=X
+11 QUIT
