PSN4PRE.m

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 ---PSN4PRE   501     printed  Apr 09, 2024@21:26:55                                                                                                                                                                                                      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