PSO126IX ;BIR/PDW-Execute CMOP INDICATOR Index ;08/12/2002
;;7.0;OUTPATIENT PHARMACY;**126**;DEC 1997
Q
CMPNDX ; new compound index on CMOP Indicator "CMP"
;check "A_x" indexes to CMP index
W !,"Updating the RX Suspense file's new 'CMP' index."
W !,"Processing the AQ, AL, AX, AP indexes into the CMP index"
F NDX="Q","L","X","P" D
. S INDX="A"_NDX W !!,INDX
. S SDT=0 F S SDT=$O(^PS(52.5,INDX,SDT)) Q:'SDT D
.. S DFN=0 F S DFN=$O(^PS(52.5,INDX,SDT,DFN)) Q:'DFN D
... S REC=0 F S REC=$O(^PS(52.5,INDX,SDT,DFN,REC)) Q:'REC D
.... S F=$G(^PS(52.5,REC,0))
.... I 'F K ^PS(52.5,INDX,SDT,DFN,REC) Q ;bad index
.... S TYP=$$CMPRXTYP^PSOCMOP(REC),CNT=$G(CNT)+1 I '(CNT#100) W "."
.... F VP="RX^1","SDT0^2","DFN0^3","DIV^6","STAT^7" D PIECE(F,U,VP)
.... I NDX=STAT,DFN=DFN0,SDT=SDT0
.... E K ^PS(52.5,INDX,SDT,DFN,REC)
.... I STAT'="",$D(^PS(52.5,"CMP",STAT,TYP,DIV,SDT0,DFN,REC)) S ^PS(52.5,"CMP",NDX,TYP,DIV,SDT,DFN,REC)=""
Q
PIECE(REC,DLM,VP) ; VP="Variable^Piece" : S Variable=$P(REC,DLM,Piece)
N V,P S V=$P(VP,DLM),P=$P(VP,DLM,2),@V=$P(REC,DLM,P)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO126IX 1100 printed Sep 23, 2025@19:58:43 Page 2
PSO126IX ;BIR/PDW-Execute CMOP INDICATOR Index ;08/12/2002
+1 ;;7.0;OUTPATIENT PHARMACY;**126**;DEC 1997
+2 QUIT
CMPNDX ; new compound index on CMOP Indicator "CMP"
+1 ;check "A_x" indexes to CMP index
+2 WRITE !,"Updating the RX Suspense file's new 'CMP' index."
+3 WRITE !,"Processing the AQ, AL, AX, AP indexes into the CMP index"
+4 FOR NDX="Q","L","X","P"
Begin DoDot:1
+5 SET INDX="A"_NDX
WRITE !!,INDX
+6 SET SDT=0
FOR
SET SDT=$ORDER(^PS(52.5,INDX,SDT))
if 'SDT
QUIT
Begin DoDot:2
+7 SET DFN=0
FOR
SET DFN=$ORDER(^PS(52.5,INDX,SDT,DFN))
if 'DFN
QUIT
Begin DoDot:3
+8 SET REC=0
FOR
SET REC=$ORDER(^PS(52.5,INDX,SDT,DFN,REC))
if 'REC
QUIT
Begin DoDot:4
+9 SET F=$GET(^PS(52.5,REC,0))
+10 ;bad index
IF 'F
KILL ^PS(52.5,INDX,SDT,DFN,REC)
QUIT
+11 SET TYP=$$CMPRXTYP^PSOCMOP(REC)
SET CNT=$GET(CNT)+1
IF '(CNT#100)
WRITE "."
+12 FOR VP="RX^1","SDT0^2","DFN0^3","DIV^6","STAT^7"
DO PIECE(F,U,VP)
+13 IF NDX=STAT
IF DFN=DFN0
IF SDT=SDT0
+14 IF '$TEST
KILL ^PS(52.5,INDX,SDT,DFN,REC)
+15 IF STAT'=""
IF $DATA(^PS(52.5,"CMP",STAT,TYP,DIV,SDT0,DFN,REC))
SET ^PS(52.5,"CMP",NDX,TYP,DIV,SDT,DFN,REC)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
PIECE(REC,DLM,VP) ; VP="Variable^Piece" : S Variable=$P(REC,DLM,Piece)
+1 NEW V,P
SET V=$PIECE(VP,DLM)
SET P=$PIECE(VP,DLM,2)
SET @V=$PIECE(REC,DLM,P)
+2 QUIT
