PSOVCC0.m

PSOVCC0 ;ORLFO/FJF/WC - PSO Activity Logs ; Mar 20, 2023@12:57:56

 ;;7.0;OUTPATIENT PHARMACY;**707**;DEC 1997;Build 18

 ; 

 ; External calls:

 ;

 ; Description       ICR     Notes

 ; -----------       ------  -------

 ; Reference to ENCODE^XLFJSON in #6682      

 ; Reference to GET^DDE in #7008     

 ; Reference to FMTHL7^XLFDT, HTFM^XLFDT in #10103    

 ; Reference to FIND1^DIC in #2051    

 ; Reference to UPD^DGENDBS in #7350    

 ; Reference to GETDFN^MPIFAPI,GETADFN^MPIFAPI in #2702

 ; Reference to UPDATE^MPIFAPI in #2706

 ; Reference to UP^XLFSTR in #10103

 ; Reference to ^%DT in #10003

 ;

 ;

PSOVPADDR(PSOVRTN,PSOVICN,PSOVADDR,PSOVATYP) ; Update temporary address in Patient file (#2)

 ; Input:  PSOVICN     (required) - Patient ICN

 ;         PSOVADDR   (required) - Address

 ;           - format ARRAY(fieldname)=field_value

 ;           - e.g. addr("City")="Alexandria"

 ;                  addr("Country")="Canada"

 ;                  addr("County")="Yorkshire"

 ;                  addr("EndDate")="10/31/2022"

 ;                  addr("PhoneNumber")="987-654-3219"

 ;                  addr("PostCode")="SK37 4ED9"

 ;                  addr("Province")="Saskatchewan"

 ;                  addr("StartDate")="09/01/2022"

 ;                  addr("State")="TX"

 ;                  addr("StreetL1")="Flat 9"

 ;                  addr("StreetL2")="The Orchards"

 ;                  addr("StreetL3")="Sharp Avenue"

 ;                  addr("Zip")=95739

 ;                  addr("Zip+4")="95739-0001"

 ;          PSOVATYP   (required) - Indicator of which address is to be updated

 ;                  T - temporary address

 ;                  O - Other, yet to be determined

 ;         

 ; Output: PSOVRTN - Return Value

 ;                1 for success

 ;               -1 - error message for failure

 ;

 ; check for required input parameters

 I $G(PSOVICN)="" S PSOVRTN="-1 - ICN is required" Q

 I '$D(PSOVADDR) S PSOVRTN="-1 - Address is required" Q

 I '$D(PSOVATYP) S PSOVRTN="-1 - Address type is required" Q

 ;

 ; check ICN is valid

 N DFN

 S DFN=$$GETADFN^MPIFAPI($P(PSOVICN,"V"))

 ;

 I +DFN=-1 S PSOVRTN="-1 - ICN not recognised" Q

 ;

 ; convert input json to M array PSOVM

 D J2MAR(.PSOVADDR,.PSOVM)

 ;

 N FDA,PSOVERR

 S FDA(.1211)=$G(PSOVM("StreetL1"))

 S FDA(.1212)=$G(PSOVM("StreetL2"))

 S FDA(.1213)=$G(PSOVM("StreetL3"))

 S FDA(.1214)=$G(PSOVM("City"))

 I $D(PSOVM("State")) D

 .N PSOVSTATE

 .S PSOVSTATE=$$UP^XLFSTR(PSOVM("State"))

 .S FDA(.1215)=$O(^DIC(5,"B",PSOVSTATE,""))

 S FDA(.1216)=$G(PSOVM("Zip"))

 S FDA(.1217)=$$EX2FM($G(PSOVM("StartDate")))

 S FDA(.1218)=$$EX2FM($G(PSOVM("EndDate")))

 S FDA(.1219)=$G(PSOVM("PhoneNumber"))

 S FDA(.1221)=$G(PSOVM("Province"))

 S FDA(.1222)=$G(PSOVM("PostCode"))

 N CNTRY

 S CNTRY=$$CNTCHK($G(PSOVM("Country")))

 I CNTRY=0 S CNTRY=""

 S FDA(.1223)=CNTRY

 I $D(PSOVADDR("County")) D

 .N PSOVCOUNTY

 .S PSOVCOUNTY=$$UP^XLFSTR(PSOVM("County"))

 .S FDA(.12111)=PSOVCOUNTY

 S FDA(.12112)=$G(PSOVM("Zip+4"))

 ;

 S PSOVRTN=$$UPD^DGENDBS(2,DFN,.FDA,.PSOVERR)

 I +PSOVRTN'=1 S PSOVRTN=-1_" - "_PSOVERR

 S PSOVRTN="1 - Temporary Address Updated"

 Q

 ;

J2MAR(JARR,PSOVM) ; convert passed json into M array

 ; Input:

 ;   JARR   - json

 ;   PSOVM - M array

 N LSUB,I

 S LSUB=$O(PSOVADDR(""),-1)

 F I=2:2:LSUB-2 S PSOVM(PSOVADDR(I))=PSOVADDR(I+1)

 Q 1

 ;

 ; Convert external date to FileMan date

EX2FM(X) ; Conversion

 ;

 ; Input:

 ;   X - external date or FileMan Date 

 ;

 ; Output:

 ;   Y - FileMan Date or -1 

 ;

 N Y

 S X=$G(X)

 D ^%DT

 K X,%DT

 Q Y

 ;

 ;

PSOVGTADDR(PSOVRTN,PSOVICN,PSOVATYP) ; Retrieve address in Patient file (#2)

 ;

 ; Input:  PSOVICN   (required) - Patient ICN

 ;         PSOVATYP  (required) - Indicator of which address is to be retrieved

 ;                  T - temporary address

 ;                  O - Other, yet to be determined

 ; Output: PSOVRTN - Return Value

 ;                temporary address in json format

 ;               -1 - error message for failure

 ;

 ;

 ; check for required input parameters

 I $G(PSOVICN)="" S PSOVRTN="-1 - ICN is required" Q

 I '$D(PSOVATYP) S PSOVRTN="-1 - Address type is required" Q

 ;

 ; check ICN is valid

 N DFN

 S DFN=$$GETDFN^MPIF001(PSOVICN)

 ;

 I +DFN=-1 S PSOVRTN="-1 - ICN not recognised" Q

 ;

 N QUERY

 S QUERY("PATIENT")=DFN

 N PSOVTMP D GET^DDE("PSO TEMPORARY ADDRESS",DFN,,0,,"PSOVTMP")

 S PSOVRTN=$G(PSOVTMP(1))

 I PSOVRTN="" S PSOVRTN="0 - No data - there is no temporary address data for ICN "_PSOVICN

 Q

 ;

CNTCHK(CNTRY) ;

 ;

 N COUNTRY

 S COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"D","","ERROR")

 I COUNTRY=0 D

 .S COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"B","","ERROR")

 Q COUNTRY

 ;

 ; --------

 ; 

ECME(PSOVO,PSOVRXN)  ; ECME Log

 ;

 ; Input:  PSOVRXN   (required) - Prescription number  

 ;         

 ; Output: PSOVRTN - Return Value

 ;                   ECME log in json format

 ;               -1 - error message for failure

 ;

 ; check for required input parameters

 I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q

 ;

 I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q

 N ERR,PSOVIEN

 S PSOVIEN=$O(^TMP($J,"PSOV",-1))

 D GET^DDE("PSO ECME M",PSOVIEN,,0,,"PSOVO","ERR")

 I $D(ERR) D NORXNER("-1^Error in Retrieval") Q

 I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no ECME entries for this prescription") Q

 D TIDY()

 Q

 ;

 ; ---------

 ;

ERX(PSOVO,PSOVRXN)  ; eRx Log

 ;

 ; Input:  PSOVRXN   (required) - Prescription number  

 ;

 ; Output: PSOVRTN - Return Value

 ;                   ERX log in json format

 ;               -1 - error message for failure

 ;

 ; check for required input parameters

 I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q

 ;

 I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q

 N ERR,PSOVIEN

 S PSOVIEN=$O(^TMP($J,"PSOV",-1))

 ;

 D GET^DDE("PSO ERX M",PSOVIEN,,0,,"PSOVO","ERR")

 I $D(ERR) D NORXNER("-1^Error in Retrieval") Q

 I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no ERX entries for this prescription") Q

 D TIDY()

 Q

 ;

 ; --------

 ;

LELF(PSOVO,PSOVRXN)  ; Lot/Expiration Log File

 ;

 ; Input:  PSOVRXN   (required) - Prescription number

 ;

 ; Output: PSOVRTN - Return Value

 ;                   Lot/Expiration log in json format

 ;               -1 - error message for failure

 ;

 ; check for required input parameters

 I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q

 ;

 I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q

 N ERR,PSOVIEN

 S PSOVIEN=$O(^TMP($J,"PSOV",-1))

 ;

 D GET^DDE("PSO LOT EXP M",PSOVIEN,,0,,"PSOVO","ERR")

 I $D(ERR) D NORXNER("-1^Error in Retrieval") Q 

 I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no Lot_Expiration entries for this prescription") Q

 D TIDY()

 Q

 ;

 ; --------

NORXNER(ERROR) ; handle messages for input parameter issue or no data

 ;

 N ZXC,PSOVRT

 S PSOVRT="PSOVO"

 S ECMER=ERROR

 D MERGE(0)

 K PSOVO(0)

 K PSOVO(1)

 D ENCODE^XLFJSON("ECM",.PSOVRT)

 S ZXC=@(PSOVRT_"(1)")

 S ZXC=$$SWAP^PSOUTCRM(ZXC,"\/","/")

 S @PSOVRT=ZXC

 K ECM,ECMER

 Q

 ;

 ;

TRNSFRM(X,SEP,BRC) ; remove extra quotes from string

 ;

 ; X   - string processes

 ; SEP - delimiter on which string is parsed

 ; BRC - opening or closing curly brace

 ;

 Q $P(X,SEP)_SEP_""":"_BRC_$P(X,BRC,4,$L(X,BRC))

 ;

TIDY() ; tidy up output string

 ;

 S PSOVO(1)="{"_$P(PSOVO(1),"{",2,$L(PSOVO(1),"{"))

 N PSOVA1,PSOVA2,CT

 S CT=$L(PSOVO(1),"}, {")

 M PSOVA1=PSOVO(1)

 M PSOVA2("data","items")=PSOVA1

 S PSOVA2("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($H))

 S PSOVA2("data","total items")=CT

 D ENCODE^XLFJSON("PSOVA2","PSOVO")

 S PSOVO(1)=$TR(PSOVO(1),"\\\")

 S PSOVO=$$CHOP(PSOVO(1))

 K PSOVO(0)

 ;

 S PSOVO=$$TRNSFRM(PSOVO,"items","{")

 S PSOVO=$RE($$TRNSFRM($RE(PSOVO),"smeti latot","}"))

 S PSOVO=$RE($P($RE(PSOVO),":",1,3)_","_$P($RE(PSOVO),":",4,$L($RE(PSOVO),":")))

 ;

 Q

 ;

MERGE(CT) ; merge into output array as json

 ;

 M ECM("data","items")=ECMER

 S ECM("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($H))

 S ECM("data","total items")=CT

 Q

 ;

 ;

NTOS(X) ; convert numbers to strings

 ;

 N W,Y,L,M,I

 S L=$P(X,":",1),M=$TR($P(X,":",2,$L(X,":")),"][")

 S W=$P($P(X,"[",2),"]",1)

 F I=1:1:$L(W,", ") I $P(W,", ",I)=+$P(W,", ",I) D

 .S $P(M,", ",I)=""""_$P(M,", ",I)_""""

 S $P(L,":",2)="["_M_"]"

 Q L

 ;

CHOP(S) ; remove "\ and \" from input S

 N P,B,C,I

 S P="""\"

 S B="" F I=1:1:$L(S,P) S B=B_$P(S,P,I)

 S P="\"""

 S C="" F I=1:1:$L(B,P) S C=C_$P(B,P,I)

 Q C

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOVCC0   8745     printed  Apr 09, 2024@21:28:07                                                                                                                                                                                                     Page 2

PSOVCC0   ;ORLFO/FJF/WC - PSO Activity Logs ; Mar 20, 2023@12:57:56

 +1       ;;7.0;OUTPATIENT PHARMACY;**707**;DEC 1997;Build 18

 +2       ; 

 +3       ; External calls:

 +4       ;

 +5       ; Description       ICR     Notes

 +6       ; -----------       ------  -------

 +7       ; Reference to ENCODE^XLFJSON in #6682      

 +8       ; Reference to GET^DDE in #7008     

 +9       ; Reference to FMTHL7^XLFDT, HTFM^XLFDT in #10103    

 +10      ; Reference to FIND1^DIC in #2051    

 +11      ; Reference to UPD^DGENDBS in #7350    

 +12      ; Reference to GETDFN^MPIFAPI,GETADFN^MPIFAPI in #2702

 +13      ; Reference to UPDATE^MPIFAPI in #2706

 +14      ; Reference to UP^XLFSTR in #10103

 +15      ; Reference to ^%DT in #10003

 +16      ;

 +17      ;

PSOVPADDR(PSOVRTN,PSOVICN,PSOVADDR,PSOVATYP) ; Update temporary address in Patient file (#2)

 +1       ; Input:  PSOVICN     (required) - Patient ICN

 +2       ;         PSOVADDR   (required) - Address

 +3       ;           - format ARRAY(fieldname)=field_value

 +4       ;           - e.g. addr("City")="Alexandria"

 +5       ;                  addr("Country")="Canada"

 +6       ;                  addr("County")="Yorkshire"

 +7       ;                  addr("EndDate")="10/31/2022"

 +8       ;                  addr("PhoneNumber")="987-654-3219"

 +9       ;                  addr("PostCode")="SK37 4ED9"

 +10      ;                  addr("Province")="Saskatchewan"

 +11      ;                  addr("StartDate")="09/01/2022"

 +12      ;                  addr("State")="TX"

 +13      ;                  addr("StreetL1")="Flat 9"

 +14      ;                  addr("StreetL2")="The Orchards"

 +15      ;                  addr("StreetL3")="Sharp Avenue"

 +16      ;                  addr("Zip")=95739

 +17      ;                  addr("Zip+4")="95739-0001"

 +18      ;          PSOVATYP   (required) - Indicator of which address is to be updated

 +19      ;                  T - temporary address

 +20      ;                  O - Other, yet to be determined

 +21      ;         

 +22      ; Output: PSOVRTN - Return Value

 +23      ;                1 for success

 +24      ;               -1 - error message for failure

 +25      ;

 +26      ; check for required input parameters

 +27       IF $GET(PSOVICN)=""

               SET PSOVRTN="-1 - ICN is required"

               QUIT 

 +28       IF '$DATA(PSOVADDR)

               SET PSOVRTN="-1 - Address is required"

               QUIT 

 +29       IF '$DATA(PSOVATYP)

               SET PSOVRTN="-1 - Address type is required"

               QUIT 

 +30      ;

 +31      ; check ICN is valid

 +32       NEW DFN

 +33       SET DFN=$$GETADFN^MPIFAPI($PIECE(PSOVICN,"V"))

 +34      ;

 +35       IF +DFN=-1

               SET PSOVRTN="-1 - ICN not recognised"

               QUIT 

 +36      ;

 +37      ; convert input json to M array PSOVM

 +38       DO J2MAR(.PSOVADDR,.PSOVM)

 +39      ;

 +40       NEW FDA,PSOVERR

 +41       SET FDA(.1211)=$GET(PSOVM("StreetL1"))

 +42       SET FDA(.1212)=$GET(PSOVM("StreetL2"))

 +43       SET FDA(.1213)=$GET(PSOVM("StreetL3"))

 +44       SET FDA(.1214)=$GET(PSOVM("City"))

 +45       IF $DATA(PSOVM("State"))

               Begin DoDot:1

 +46               NEW PSOVSTATE

 +47               SET PSOVSTATE=$$UP^XLFSTR(PSOVM("State"))

 +48               SET FDA(.1215)=$ORDER(^DIC(5,"B",PSOVSTATE,""))

               End DoDot:1

 +49       SET FDA(.1216)=$GET(PSOVM("Zip"))

 +50       SET FDA(.1217)=$$EX2FM($GET(PSOVM("StartDate")))

 +51       SET FDA(.1218)=$$EX2FM($GET(PSOVM("EndDate")))

 +52       SET FDA(.1219)=$GET(PSOVM("PhoneNumber"))

 +53       SET FDA(.1221)=$GET(PSOVM("Province"))

 +54       SET FDA(.1222)=$GET(PSOVM("PostCode"))

 +55       NEW CNTRY

 +56       SET CNTRY=$$CNTCHK($GET(PSOVM("Country")))

 +57       IF CNTRY=0

               SET CNTRY=""

 +58       SET FDA(.1223)=CNTRY

 +59       IF $DATA(PSOVADDR("County"))

               Begin DoDot:1

 +60               NEW PSOVCOUNTY

 +61               SET PSOVCOUNTY=$$UP^XLFSTR(PSOVM("County"))

 +62               SET FDA(.12111)=PSOVCOUNTY

               End DoDot:1

 +63       SET FDA(.12112)=$GET(PSOVM("Zip+4"))

 +64      ;

 +65       SET PSOVRTN=$$UPD^DGENDBS(2,DFN,.FDA,.PSOVERR)

 +66       IF +PSOVRTN'=1

               SET PSOVRTN=-1_" - "_PSOVERR

 +67       SET PSOVRTN="1 - Temporary Address Updated"

 +68       QUIT 

 +69      ;

J2MAR(JARR,PSOVM) ; convert passed json into M array

 +1       ; Input:

 +2       ;   JARR   - json

 +3       ;   PSOVM - M array

 +4        NEW LSUB,I

 +5        SET LSUB=$ORDER(PSOVADDR(""),-1)

 +6        FOR I=2:2:LSUB-2

               SET PSOVM(PSOVADDR(I))=PSOVADDR(I+1)

 +7        QUIT 1

 +8       ;

 +9       ; Convert external date to FileMan date

EX2FM(X)  ; Conversion

 +1       ;

 +2       ; Input:

 +3       ;   X - external date or FileMan Date 

 +4       ;

 +5       ; Output:

 +6       ;   Y - FileMan Date or -1 

 +7       ;

 +8        NEW Y

 +9        SET X=$GET(X)

 +10       DO ^%DT

 +11       KILL X,%DT

 +12       QUIT Y

 +13      ;

 +14      ;

PSOVGTADDR(PSOVRTN,PSOVICN,PSOVATYP) ; Retrieve address in Patient file (#2)

 +1       ;

 +2       ; Input:  PSOVICN   (required) - Patient ICN

 +3       ;         PSOVATYP  (required) - Indicator of which address is to be retrieved

 +4       ;                  T - temporary address

 +5       ;                  O - Other, yet to be determined

 +6       ; Output: PSOVRTN - Return Value

 +7       ;                temporary address in json format

 +8       ;               -1 - error message for failure

 +9       ;

 +10      ;

 +11      ; check for required input parameters

 +12       IF $GET(PSOVICN)=""

               SET PSOVRTN="-1 - ICN is required"

               QUIT 

 +13       IF '$DATA(PSOVATYP)

               SET PSOVRTN="-1 - Address type is required"

               QUIT 

 +14      ;

 +15      ; check ICN is valid

 +16       NEW DFN

 +17       SET DFN=$$GETDFN^MPIF001(PSOVICN)

 +18      ;

 +19       IF +DFN=-1

               SET PSOVRTN="-1 - ICN not recognised"

               QUIT 

 +20      ;

 +21       NEW QUERY

 +22       SET QUERY("PATIENT")=DFN

 +23       NEW PSOVTMP

           DO GET^DDE("PSO TEMPORARY ADDRESS",DFN,,0,,"PSOVTMP")

 +24       SET PSOVRTN=$GET(PSOVTMP(1))

 +25       IF PSOVRTN=""

               SET PSOVRTN="0 - No data - there is no temporary address data for ICN "_PSOVICN

 +26       QUIT 

 +27      ;

CNTCHK(CNTRY) ;

 +1       ;

 +2        NEW COUNTRY

 +3        SET COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"D","","ERROR")

 +4        IF COUNTRY=0

               Begin DoDot:1

 +5                SET COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"B","","ERROR")

               End DoDot:1

 +6        QUIT COUNTRY

 +7       ;

 +8       ; --------

 +9       ; 

ECME(PSOVO,PSOVRXN) ; ECME Log

 +1       ;

 +2       ; Input:  PSOVRXN   (required) - Prescription number  

 +3       ;         

 +4       ; Output: PSOVRTN - Return Value

 +5       ;                   ECME log in json format

 +6       ;               -1 - error message for failure

 +7       ;

 +8       ; check for required input parameters

 +9        IF $GET(PSOVRXN)=""

               DO NORXNER("-1 - Prescription number is required")

               QUIT 

 +10      ;

 +11       IF '$$RXVAL^PSOUTCRM(PSOVRXN)

               DO NORXNER("-2^ Prescription Number is not recognized")

               QUIT 

 +12       NEW ERR,PSOVIEN

 +13       SET PSOVIEN=$ORDER(^TMP($JOB,"PSOV",-1))

 +14       DO GET^DDE("PSO ECME M",PSOVIEN,,0,,"PSOVO","ERR")

 +15       IF $DATA(ERR)

               DO NORXNER("-1^Error in Retrieval")

               QUIT 

 +16       IF $LENGTH(PSOVO(1),"}")<3

               DO NORXNER("0^No data - there are no ECME entries for this prescription")

               QUIT 

 +17       DO TIDY()

 +18       QUIT 

 +19      ;

 +20      ; ---------

 +21      ;

ERX(PSOVO,PSOVRXN) ; eRx Log

 +1       ;

 +2       ; Input:  PSOVRXN   (required) - Prescription number  

 +3       ;

 +4       ; Output: PSOVRTN - Return Value

 +5       ;                   ERX log in json format

 +6       ;               -1 - error message for failure

 +7       ;

 +8       ; check for required input parameters

 +9        IF $GET(PSOVRXN)=""

               DO NORXNER("-1 - Prescription number is required")

               QUIT 

 +10      ;

 +11       IF '$$RXVAL^PSOUTCRM(PSOVRXN)

               DO NORXNER("-2^ Prescription Number is not recognized")

               QUIT 

 +12       NEW ERR,PSOVIEN

 +13       SET PSOVIEN=$ORDER(^TMP($JOB,"PSOV",-1))

 +14      ;

 +15       DO GET^DDE("PSO ERX M",PSOVIEN,,0,,"PSOVO","ERR")

 +16       IF $DATA(ERR)

               DO NORXNER("-1^Error in Retrieval")

               QUIT 

 +17       IF $LENGTH(PSOVO(1),"}")<3

               DO NORXNER("0^No data - there are no ERX entries for this prescription")

               QUIT 

 +18       DO TIDY()

 +19       QUIT 

 +20      ;

 +21      ; --------

 +22      ;

LELF(PSOVO,PSOVRXN) ; Lot/Expiration Log File

 +1       ;

 +2       ; Input:  PSOVRXN   (required) - Prescription number

 +3       ;

 +4       ; Output: PSOVRTN - Return Value

 +5       ;                   Lot/Expiration log in json format

 +6       ;               -1 - error message for failure

 +7       ;

 +8       ; check for required input parameters

 +9        IF $GET(PSOVRXN)=""

               DO NORXNER("-1 - Prescription number is required")

               QUIT 

 +10      ;

 +11       IF '$$RXVAL^PSOUTCRM(PSOVRXN)

               DO NORXNER("-2^ Prescription Number is not recognized")

               QUIT 

 +12       NEW ERR,PSOVIEN

 +13       SET PSOVIEN=$ORDER(^TMP($JOB,"PSOV",-1))

 +14      ;

 +15       DO GET^DDE("PSO LOT EXP M",PSOVIEN,,0,,"PSOVO","ERR")

 +16       IF $DATA(ERR)

               DO NORXNER("-1^Error in Retrieval")

               QUIT 

 +17       IF $LENGTH(PSOVO(1),"}")<3

               DO NORXNER("0^No data - there are no Lot_Expiration entries for this prescription")

               QUIT 

 +18       DO TIDY()

 +19       QUIT 

 +20      ;

 +21      ; --------

NORXNER(ERROR) ; handle messages for input parameter issue or no data

 +1       ;

 +2        NEW ZXC,PSOVRT

 +3        SET PSOVRT="PSOVO"

 +4        SET ECMER=ERROR

 +5        DO MERGE(0)

 +6        KILL PSOVO(0)

 +7        KILL PSOVO(1)

 +8        DO ENCODE^XLFJSON("ECM",.PSOVRT)

 +9        SET ZXC=@(PSOVRT_"(1)")

 +10       SET ZXC=$$SWAP^PSOUTCRM(ZXC,"\/","/")

 +11       SET @PSOVRT=ZXC

 +12       KILL ECM,ECMER

 +13       QUIT 

 +14      ;

 +15      ;

TRNSFRM(X,SEP,BRC) ; remove extra quotes from string

 +1       ;

 +2       ; X   - string processes

 +3       ; SEP - delimiter on which string is parsed

 +4       ; BRC - opening or closing curly brace

 +5       ;

 +6        QUIT $PIECE(X,SEP)_SEP_""":"_BRC_$PIECE(X,BRC,4,$LENGTH(X,BRC))

 +7       ;

TIDY()    ; tidy up output string

 +1       ;

 +2        SET PSOVO(1)="{"_$PIECE(PSOVO(1),"{",2,$LENGTH(PSOVO(1),"{"))

 +3        NEW PSOVA1,PSOVA2,CT

 +4        SET CT=$LENGTH(PSOVO(1),"}, {")

 +5        MERGE PSOVA1=PSOVO(1)

 +6        MERGE PSOVA2("data","items")=PSOVA1

 +7        SET PSOVA2("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG))

 +8        SET PSOVA2("data","total items")=CT

 +9        DO ENCODE^XLFJSON("PSOVA2","PSOVO")

 +10       SET PSOVO(1)=$TRANSLATE(PSOVO(1),"\\\")

 +11       SET PSOVO=$$CHOP(PSOVO(1))

 +12       KILL PSOVO(0)

 +13      ;

 +14       SET PSOVO=$$TRNSFRM(PSOVO,"items","{")

 +15       SET PSOVO=$REVERSE($$TRNSFRM($REVERSE(PSOVO),"smeti latot","}"))

 +16       SET PSOVO=$REVERSE($PIECE($REVERSE(PSOVO),":",1,3)_","_$PIECE($REVERSE(PSOVO),":",4,$LENGTH($REVERSE(PSOVO),":")))

 +17      ;

 +18       QUIT 

 +19      ;

MERGE(CT) ; merge into output array as json

 +1       ;

 +2        MERGE ECM("data","items")=ECMER

 +3        SET ECM("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG))

 +4        SET ECM("data","total items")=CT

 +5        QUIT 

 +6       ;

 +7       ;

NTOS(X)   ; convert numbers to strings

 +1       ;

 +2        NEW W,Y,L,M,I

 +3        SET L=$PIECE(X,":",1)

           SET M=$TRANSLATE($PIECE(X,":",2,$LENGTH(X,":")),"][")

 +4        SET W=$PIECE($PIECE(X,"[",2),"]",1)

 +5        FOR I=1:1:$LENGTH(W,", ")

               IF $PIECE(W,", ",I)=+$PIECE(W,", ",I)

                   Begin DoDot:1

 +6                    SET $PIECE(M,", ",I)=""""_$PIECE(M,", ",I)_""""

                   End DoDot:1

 +7        SET $PIECE(L,":",2)="["_M_"]"

 +8        QUIT L

 +9       ;

CHOP(S)   ; remove "\ and \" from input S

 +1        NEW P,B,C,I

 +2        SET P="""\"

 +3        SET B=""

           FOR I=1:1:$LENGTH(S,P)

               SET B=B_$PIECE(S,P,I)

 +4        SET P="\"""

 +5        SET C=""

           FOR I=1:1:$LENGTH(B,P)

               SET C=C_$PIECE(B,P,I)

 +6        QUIT C

 +7       ;