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 ---[H[J[2J[HPSO679P 1632 printed Sep 23, 2025@19:59:38 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
