PSO679P.m

PSO679P ;BAYPINES/KML - POST INSTALL TO PATCH PSO,679 ; April 18, 2022

 ;;7.0;OUTPATIENT PHARMACY;**679**;DEC 1997;Build 16

 ;

 Q

POST ;;  field 52.1,94 has been changed from a set of codes to a free text value

 ; need to modify the data that is stored from its coded value to its external representation

 ; the following illustrates what values will be stored:

 ;    '1' will be changed to CPRS; 

 ;    '2' will be changed to OUTPATIENT PHARMACY; 

 ;    '3' will be changed to CONTACT CENTER; 

 ;    '4' will be changed to AUDIOCARE; 

 ;    '5' will be changed to MY HEALTHEVET; 

 ; ^PSRX(PSORXN,1,PSOITF,"RF1")   change set of code values to external representation

 N REFSRC,X1,X2,ENTRIES,COUNT,TEXT

 S ENTRIES=$P(^PSRX(0),"^",4)

 S TEXT(1)="Starting to convert the data at the REFILL SOURCE field (#52.1,94)"

 S TEXT(2)="from a SET OF CODES to its Free Text value."

 S TEXT(3)=""

 S TEXT(4)="There are "_ENTRIES_" prescription entries to process."

 S TEXT(5)=""

 D MES^XPDUTL(.TEXT)

 D CONVERT

 Q

 ;

CONVERT ;

 S (X1,COUNT)=0

 F  S X1=$O(^PSRX(X1)) Q:'X1  D

 . S COUNT=COUNT+1,X2=0

 . I COUNT#500000=0 D MES^XPDUTL("Processed "_COUNT_" entries.")

 . F  S X2=$O(^PSRX(X1,1,X2)) Q:'X2  D

 . . S REFSRC=$P($G(^PSRX(X1,1,X2,"RF1")),"^")

 . . Q:REFSRC=""

 . . L +^PSRX(X1,1,X2):5 Q:'$T

 . . S $P(^PSRX(X1,1,X2,"RF1"),"^")=$S(REFSRC=1:"CPRS",REFSRC=2:"OUTPATIENT PHARMACY",REFSRC=3:"CONTACT CENTER",REFSRC=4:"AUDIOCARE",REFSRC=5:"MY HEALTHEVET",1:REFSRC)

 . . L -^PSRX(X1,1,X2)

 . . D MES^XPDUTL("Entry "_X1_" converted to "_$P(^PSRX(X1,1,X2,"RF1"),"^"))

 D MES^XPDUTL("Conversion completed")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO679P   1632     printed  Apr 09, 2024@21:35:01                                                                                                                                                                                                     Page 2

PSO679P   ;BAYPINES/KML - POST INSTALL TO PATCH PSO,679 ; April 18, 2022

 +1       ;;7.0;OUTPATIENT PHARMACY;**679**;DEC 1997;Build 16

 +2       ;

 +3        QUIT 

POST      ;;  field 52.1,94 has been changed from a set of codes to a free text value

 +1       ; need to modify the data that is stored from its coded value to its external representation

 +2       ; the following illustrates what values will be stored:

 +3       ;    '1' will be changed to CPRS; 

 +4       ;    '2' will be changed to OUTPATIENT PHARMACY; 

 +5       ;    '3' will be changed to CONTACT CENTER; 

 +6       ;    '4' will be changed to AUDIOCARE; 

 +7       ;    '5' will be changed to MY HEALTHEVET; 

 +8       ; ^PSRX(PSORXN,1,PSOITF,"RF1")   change set of code values to external representation

 +9        NEW REFSRC,X1,X2,ENTRIES,COUNT,TEXT

 +10       SET ENTRIES=$PIECE(^PSRX(0),"^",4)

 +11       SET TEXT(1)="Starting to convert the data at the REFILL SOURCE field (#52.1,94)"

 +12       SET TEXT(2)="from a SET OF CODES to its Free Text value."

 +13       SET TEXT(3)=""

 +14       SET TEXT(4)="There are "_ENTRIES_" prescription entries to process."

 +15       SET TEXT(5)=""

 +16       DO MES^XPDUTL(.TEXT)

 +17       DO CONVERT

 +18       QUIT 

 +19      ;

CONVERT   ;

 +1        SET (X1,COUNT)=0

 +2        FOR 

               SET X1=$ORDER(^PSRX(X1))

               if 'X1

                   QUIT 

               Begin DoDot:1

 +3                SET COUNT=COUNT+1

                   SET X2=0

 +4                IF COUNT#500000=0

                       DO MES^XPDUTL("Processed "_COUNT_" entries.")

 +5                FOR 

                       SET X2=$ORDER(^PSRX(X1,1,X2))

                       if 'X2

                           QUIT 

                       Begin DoDot:2

 +6                        SET REFSRC=$PIECE($GET(^PSRX(X1,1,X2,"RF1")),"^")

 +7                        if REFSRC=""

                               QUIT 

 +8                        LOCK +^PSRX(X1,1,X2):5

                           if '$TEST

                               QUIT 

 +9                        SET $PIECE(^PSRX(X1,1,X2,"RF1"),"^")=$SELECT(REFSRC=1:"CPRS",REFSRC=2:"OUTPATIENT PHARMACY",REFSRC=3:"CONTACT CENTER",REFSRC=4:"AUDIOCARE",REFSRC=5:"MY HEALTHEVET",1:REFSRC)

 +10                       LOCK -^PSRX(X1,1,X2)

 +11                       DO MES^XPDUTL("Entry "_X1_" converted to "_$PIECE(^PSRX(X1,1,X2,"RF1"),"^"))

                       End DoDot:2

               End DoDot:1

 +12       DO MES^XPDUTL("Conversion completed")

 +13       QUIT