- PSN258P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 04 Nov 2010 11:57 AM
- ;;4.0; NATIONAL DRUG FILE;**258**; 30 Oct 98;Build 40
- ;
- BUILD ;GET PMIS INFO FROM TRANSPORT GLOBAL AND LOAD
- I '$D(XPDGREF) Q
- N DA,I,J,K,LINE,PSN,ROOT,X
- F PSN=50.621:.001:50.627 K ^PS(PSN)
- 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)
- F PSN=50.621:.001:50.627 M ^PS(PSN)=@XPDGREF@(PSN)
- K DA,I,J,K,LINE,PSN,ROOT,X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN258P 695 printed Jan 18, 2025@03:19:43 Page 2
- PSN258P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 04 Nov 2010 11:57 AM
- +1 ;;4.0; NATIONAL DRUG FILE;**258**; 30 Oct 98;Build 40
- +2 ;
- BUILD ;GET PMIS INFO FROM TRANSPORT GLOBAL AND LOAD
- +1 IF '$DATA(XPDGREF)
- QUIT
- +2 NEW DA,I,J,K,LINE,PSN,ROOT,X
- +3 FOR PSN=50.621:.001:50.627
- KILL ^PS(PSN)
- +4 SET ROOT=$NAME(@XPDGREF@("DATA"))
- SET J=0
- +5 KILL ^TMP($JOB)
- +6 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)
- +7 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
- +8 KILL ^TMP($JOB)
- +9 FOR PSN=50.621:.001:50.627
- MERGE ^PS(PSN)=@XPDGREF@(PSN)
- +10 KILL DA,I,J,K,LINE,PSN,ROOT,X
- +11 QUIT