- PSN447P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 01 Jul 2015 11:37 AM
- ;;4.0;NATIONAL DRUG FILE;**447**; 30 Oct 98;Build 100
- ;
- BUILD ;MATCH PRODUCTS
- I '$D(XPDGREF) Q
- N DA,I,J,K,LINE,PSN,ROOT,X
- S ROOT=$NA(@XPDGREF@("DATA")),J=0
- K ^TMP($J)
- F S J=$O(@ROOT@(J)) Q:'J S LINE=^(J),K=$L(LINE,"|")-1 F I=1:1:K S X=$P(LINE,"|",I),^TMP($J,$P(X,"^"))=$P(X,"^",2,4)
- S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X=$P($G(^(DA,1)),"^",1,4) S:$D(^TMP($J,DA)) X=X_"^"_^(DA) S ^PSNDF(50.68,DA,1)=X
- K ^TMP($J)
- K DA,I,J,K,LINE,PSN,ROOT,X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN447P 574 printed Dec 13, 2024@02:21:28 Page 2
- PSN447P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 01 Jul 2015 11:37 AM
- +1 ;;4.0;NATIONAL DRUG FILE;**447**; 30 Oct 98;Build 100
- +2 ;
- BUILD ;MATCH PRODUCTS
- +1 IF '$DATA(XPDGREF)
- QUIT
- +2 NEW DA,I,J,K,LINE,PSN,ROOT,X
- +3 SET ROOT=$NAME(@XPDGREF@("DATA"))
- SET J=0
- +4 KILL ^TMP($JOB)
- +5 FOR
- SET J=$ORDER(@ROOT@(J))
- if 'J
- QUIT
- SET LINE=^(J)
- SET K=$LENGTH(LINE,"|")-1
- FOR I=1:1:K
- SET X=$PIECE(LINE,"|",I)
- SET ^TMP($JOB,$PIECE(X,"^"))=$PIECE(X,"^",2,4)
- +6 SET DA=0
- FOR
- SET DA=$ORDER(^PSNDF(50.68,DA))
- if 'DA
- QUIT
- SET X=$PIECE($GET(^(DA,1)),"^",1,4)
- if $DATA(^TMP($JOB,DA))
- SET X=X_"^"_^(DA)
- SET ^PSNDF(50.68,DA,1)=X
- +7 KILL ^TMP($JOB)
- +8 KILL DA,I,J,K,LINE,PSN,ROOT,X
- +9 QUIT