- PSNUPP ;BIR/DMA-post install to load entries in NDF ; 16 Oct 97 / 9:27 AM [ 06/11/98 3:18 PM ]
- ;;3.18; NATIONAL DRUG FILE;**3**;12 Jan 98
- ;
- N ROOT,I,J,X,LINE,TOT,CT,PCT,XPDITOT
- S ROOT=$NA(@XPDGREF@("DATA")),TOT=@XPDGREF@("TOT"),XPDITOT=TOT,CT=0,PCT=.05
- D BMES^XPDUTL("Now updating entries in the National Drug File.")
- F J=1:1 Q:'$D(@ROOT@(J)) S LINE=^(J) F I=1:1:$L(LINE,"|")-1 S X=$P(LINE,"|",I),$P(^PSNDF($P(X,"^"),5,$P(X,"^",2),0),"^",7,8)=$P(X,"^",3,4),CT=CT+1 I CT/TOT'<PCT D UPDATE^XPDID(CT) S PCT=PCT+.05
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNUPP 535 printed Mar 13, 2025@21:29:49 Page 2
- PSNUPP ;BIR/DMA-post install to load entries in NDF ; 16 Oct 97 / 9:27 AM [ 06/11/98 3:18 PM ]
- +1 ;;3.18; NATIONAL DRUG FILE;**3**;12 Jan 98
- +2 ;
- +3 NEW ROOT,I,J,X,LINE,TOT,CT,PCT,XPDITOT
- +4 SET ROOT=$NAME(@XPDGREF@("DATA"))
- SET TOT=@XPDGREF@("TOT")
- SET XPDITOT=TOT
- SET CT=0
- SET PCT=.05
- +5 DO BMES^XPDUTL("Now updating entries in the National Drug File.")
- +6 FOR J=1:1
- if '$DATA(@ROOT@(J))
- QUIT
- SET LINE=^(J)
- FOR I=1:1:$LENGTH(LINE,"|")-1
- SET X=$PIECE(LINE,"|",I)
- SET $PIECE(^PSNDF($PIECE(X,"^"),5,$PIECE(X,"^",2),0),"^",7,8)=$PIECE(X,"^",3,4)
- SET CT=CT+1
- IF CT/TOT'<PCT
- DO UPDATE^XPDID(CT)
- SET PCT=PCT+.05
- +7 ;
- +8 QUIT