PSNCNT ; Birmingham ISC/WRT - reset pieces 3 & 4 on all multiple levels; 06/02/98 12:08;
;;3.18; NATIONAL DRUG FILE;**4**;12 Jan 98
D BEGIN K I,J,COUNT,LAST,HH,KK,DD,EE,RR
Q
BEGIN F I=0:0 S I=$O(^PSNDF(I)) Q:'I D VAPN,DOSE
Q
VAPN I $D(^PSNDF(I,5,0)) D LOOP
Q
LOOP S COUNT=0,LAST=0 F J=0:0 S J=$O(^PSNDF(I,5,J)) Q:'J S COUNT=COUNT+1 I LAST?1N.N S LAST=J D WRITE
Q
WRITE S $P(^PSNDF(I,5,0),"^",3)=LAST,$P(^PSNDF(I,5,0),"^",4)=COUNT
Q
DOSE I $D(^PSNDF(I,2,0)) D LOOP1,STRGTH
Q
LOOP1 S COUNT=0,LAST=0 F HH=0:0 S HH=$O(^PSNDF(I,2,HH)) Q:'HH S COUNT=COUNT+1 I LAST?1N.N S LAST=HH D WRITE1
Q
WRITE1 S $P(^PSNDF(I,2,0),"^",3)=LAST,$P(^PSNDF(I,2,0),"^",4)=COUNT
Q
STRGTH I $D(^PSNDF(I,2,HH,3,0)) D LOOP2,UNIT
Q
LOOP2 S COUNT=0,LAST=0 F KK=0:0 S KK=$O(^PSNDF(I,2,HH,3,KK)) Q:'KK S COUNT=COUNT+1 I LAST?1N.N S LAST=KK D WRITE2
Q
WRITE2 S $P(^PSNDF(I,2,HH,3,0),"^",3)=LAST,$P(^PSNDF(I,2,HH,3,0),"^",4)=COUNT
Q
UNIT I $D(^PSNDF(I,2,HH,3,KK,4,0)) D LOOP3,PSZE
Q
LOOP3 S COUNT=0,LAST=0 F DD=0:0 S DD=$O(^PSNDF(I,2,HH,3,KK,4,DD)) Q:'DD S COUNT=COUNT+1 I LAST?1N.N S LAST=DD D WRITE3
Q
WRITE3 S $P(^PSNDF(I,2,HH,3,KK,4,0),"^",3)=LAST,$P(^PSNDF(I,2,HH,3,KK,4,0),"^",4)=COUNT
Q
PSZE I $D(^PSNDF(I,2,HH,3,KK,4,DD,5,0)) D LOOP4,PTYP
Q
LOOP4 S COUNT=0,LAST=0 F EE=0:0 S EE=$O(^PSNDF(I,2,HH,3,KK,4,DD,5,EE)) Q:'EE S COUNT=COUNT+1 I LAST?1N.N S LAST=EE D WRITE4
Q
WRITE4 S $P(^PSNDF(I,2,HH,3,KK,4,DD,5,0),"^",3)=LAST,$P(^PSNDF(I,2,HH,3,KK,4,DD,5,0),"^",4)=COUNT
Q
PTYP I $D(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0)) D LOOP5,NDC
Q
LOOP5 S COUNT=0,LAST=0 F RR=0:0 S RR=$O(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR)) Q:'RR S COUNT=COUNT+1 I LAST?1N.N S LAST=RR D WRITE5
Q
WRITE5 S $P(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0),"^",3)=LAST,$P(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0),"^",4)=COUNT
Q
NDC I $D(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0)) D LOOP6
Q
LOOP6 S COUNT=0,LAST=0 F WW=0:0 S WW=$O(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,WW)) Q:'WW S COUNT=COUNT+1 I LAST?1N.N S LAST=WW D WRITE6
Q
WRITE6 S $P(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0),"^",3)=LAST,$P(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0),"^",4)=COUNT
Q
PSNCNT ; Birmingham ISC/WRT - reset pieces 3 & 4 on all multiple levels; 06/02/98 12:08;
+1 ;;3.18; NATIONAL DRUG FILE;**4**;12 Jan 98
+2 DO BEGIN
KILL I,J,COUNT,LAST,HH,KK,DD,EE,RR
+3 QUIT
BEGIN FOR I=0:0
SET I=$ORDER(^PSNDF(I))
IF 'I
QUIT
DO VAPN
DO DOSE
+1 QUIT
VAPN IF $DATA(^PSNDF(I,5,0))
DO LOOP
+1 QUIT
LOOP SET COUNT=0
SET LAST=0
FOR J=0:0
SET J=$ORDER(^PSNDF(I,5,J))
IF 'J
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=J
DO WRITE
+1 QUIT
WRITE SET $PIECE(^PSNDF(I,5,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,5,0),"^",4)=COUNT
+1 QUIT
DOSE IF $DATA(^PSNDF(I,2,0))
DO LOOP1
DO STRGTH
+1 QUIT
LOOP1 SET COUNT=0
SET LAST=0
FOR HH=0:0
SET HH=$ORDER(^PSNDF(I,2,HH))
IF 'HH
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=HH
DO WRITE1
+1 QUIT
WRITE1 SET $PIECE(^PSNDF(I,2,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,0),"^",4)=COUNT
+1 QUIT
STRGTH IF $DATA(^PSNDF(I,2,HH,3,0))
DO LOOP2
DO UNIT
+1 QUIT
LOOP2 SET COUNT=0
SET LAST=0
FOR KK=0:0
SET KK=$ORDER(^PSNDF(I,2,HH,3,KK))
IF 'KK
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=KK
DO WRITE2
+1 QUIT
WRITE2 SET $PIECE(^PSNDF(I,2,HH,3,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,HH,3,0),"^",4)=COUNT
+1 QUIT
UNIT IF $DATA(^PSNDF(I,2,HH,3,KK,4,0))
DO LOOP3
DO PSZE
+1 QUIT
LOOP3 SET COUNT=0
SET LAST=0
FOR DD=0:0
SET DD=$ORDER(^PSNDF(I,2,HH,3,KK,4,DD))
IF 'DD
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=DD
DO WRITE3
+1 QUIT
WRITE3 SET $PIECE(^PSNDF(I,2,HH,3,KK,4,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,HH,3,KK,4,0),"^",4)=COUNT
+1 QUIT
PSZE IF $DATA(^PSNDF(I,2,HH,3,KK,4,DD,5,0))
DO LOOP4
DO PTYP
+1 QUIT
LOOP4 SET COUNT=0
SET LAST=0
FOR EE=0:0
SET EE=$ORDER(^PSNDF(I,2,HH,3,KK,4,DD,5,EE))
IF 'EE
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=EE
DO WRITE4
+1 QUIT
WRITE4 SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,0),"^",4)=COUNT
+1 QUIT
PTYP IF $DATA(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0))
DO LOOP5
DO NDC
+1 QUIT
LOOP5 SET COUNT=0
SET LAST=0
FOR RR=0:0
SET RR=$ORDER(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR))
IF 'RR
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=RR
DO WRITE5
+1 QUIT
WRITE5 SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,0),"^",4)=COUNT
+1 QUIT
NDC IF $DATA(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0))
DO LOOP6
+1 QUIT
LOOP6 SET COUNT=0
SET LAST=0
FOR WW=0:0
SET WW=$ORDER(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,WW))
IF 'WW
QUIT
SET COUNT=COUNT+1
IF LAST?1N.N
SET LAST=WW
DO WRITE6
+1 QUIT
WRITE6 SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0),"^",3)=LAST
SET $PIECE(^PSNDF(I,2,HH,3,KK,4,DD,5,EE,6,RR,7,0),"^",4)=COUNT
+1 QUIT
