PSO126IX.m

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 ---PSO126IX   1100     printed  Apr 09, 2024@21:32:36                                                                                                                                                                                                    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