- 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
