Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOVCC0

PSOVCC0.m

Go to the documentation of this file.
  1. PSOVCC0 ;ORLFO/FJF/WC - PSO Activity Logs ; Mar 20, 2023@12:57:56
  1. ;;7.0;OUTPATIENT PHARMACY;**707**;DEC 1997;Build 18
  1. ;
  1. ; External calls:
  1. ;
  1. ; Description ICR Notes
  1. ; ----------- ------ -------
  1. ; Reference to ENCODE^XLFJSON in #6682
  1. ; Reference to GET^DDE in #7008
  1. ; Reference to FMTHL7^XLFDT, HTFM^XLFDT in #10103
  1. ; Reference to FIND1^DIC in #2051
  1. ; Reference to UPD^DGENDBS in #7350
  1. ; Reference to GETDFN^MPIFAPI,GETADFN^MPIFAPI in #2702
  1. ; Reference to UPDATE^MPIFAPI in #2706
  1. ; Reference to UP^XLFSTR in #10103
  1. ; Reference to ^%DT in #10003
  1. ;
  1. ;
  1. PSOVPADDR(PSOVRTN,PSOVICN,PSOVADDR,PSOVATYP) ; Update temporary address in Patient file (#2)
  1. ; Input: PSOVICN (required) - Patient ICN
  1. ; PSOVADDR (required) - Address
  1. ; - format ARRAY(fieldname)=field_value
  1. ; - e.g. addr("City")="Alexandria"
  1. ; addr("Country")="Canada"
  1. ; addr("County")="Yorkshire"
  1. ; addr("EndDate")="10/31/2022"
  1. ; addr("PhoneNumber")="987-654-3219"
  1. ; addr("PostCode")="SK37 4ED9"
  1. ; addr("Province")="Saskatchewan"
  1. ; addr("StartDate")="09/01/2022"
  1. ; addr("State")="TX"
  1. ; addr("StreetL1")="Flat 9"
  1. ; addr("StreetL2")="The Orchards"
  1. ; addr("StreetL3")="Sharp Avenue"
  1. ; addr("Zip")=95739
  1. ; addr("Zip+4")="95739-0001"
  1. ; PSOVATYP (required) - Indicator of which address is to be updated
  1. ; T - temporary address
  1. ; O - Other, yet to be determined
  1. ;
  1. ; Output: PSOVRTN - Return Value
  1. ; 1 for success
  1. ; -1 - error message for failure
  1. ;
  1. ; check for required input parameters
  1. I $G(PSOVICN)="" S PSOVRTN="-1 - ICN is required" Q
  1. I '$D(PSOVADDR) S PSOVRTN="-1 - Address is required" Q
  1. I '$D(PSOVATYP) S PSOVRTN="-1 - Address type is required" Q
  1. ;
  1. ; check ICN is valid
  1. N DFN
  1. S DFN=$$GETADFN^MPIFAPI($P(PSOVICN,"V"))
  1. ;
  1. I +DFN=-1 S PSOVRTN="-1 - ICN not recognised" Q
  1. ;
  1. ; convert input json to M array PSOVM
  1. D J2MAR(.PSOVADDR,.PSOVM)
  1. ;
  1. N FDA,PSOVERR
  1. S FDA(.1211)=$G(PSOVM("StreetL1"))
  1. S FDA(.1212)=$G(PSOVM("StreetL2"))
  1. S FDA(.1213)=$G(PSOVM("StreetL3"))
  1. S FDA(.1214)=$G(PSOVM("City"))
  1. I $D(PSOVM("State")) D
  1. .N PSOVSTATE
  1. .S PSOVSTATE=$$UP^XLFSTR(PSOVM("State"))
  1. .S FDA(.1215)=$O(^DIC(5,"B",PSOVSTATE,""))
  1. S FDA(.1216)=$G(PSOVM("Zip"))
  1. S FDA(.1217)=$$EX2FM($G(PSOVM("StartDate")))
  1. S FDA(.1218)=$$EX2FM($G(PSOVM("EndDate")))
  1. S FDA(.1219)=$G(PSOVM("PhoneNumber"))
  1. S FDA(.1221)=$G(PSOVM("Province"))
  1. S FDA(.1222)=$G(PSOVM("PostCode"))
  1. N CNTRY
  1. S CNTRY=$$CNTCHK($G(PSOVM("Country")))
  1. I CNTRY=0 S CNTRY=""
  1. S FDA(.1223)=CNTRY
  1. I $D(PSOVADDR("County")) D
  1. .N PSOVCOUNTY
  1. .S PSOVCOUNTY=$$UP^XLFSTR(PSOVM("County"))
  1. .S FDA(.12111)=PSOVCOUNTY
  1. S FDA(.12112)=$G(PSOVM("Zip+4"))
  1. ;
  1. S PSOVRTN=$$UPD^DGENDBS(2,DFN,.FDA,.PSOVERR)
  1. I +PSOVRTN'=1 S PSOVRTN=-1_" - "_PSOVERR
  1. S PSOVRTN="1 - Temporary Address Updated"
  1. Q
  1. ;
  1. J2MAR(JARR,PSOVM) ; convert passed json into M array
  1. ; Input:
  1. ; JARR - json
  1. ; PSOVM - M array
  1. N LSUB,I
  1. S LSUB=$O(PSOVADDR(""),-1)
  1. F I=2:2:LSUB-2 S PSOVM(PSOVADDR(I))=PSOVADDR(I+1)
  1. Q 1
  1. ;
  1. ; Convert external date to FileMan date
  1. EX2FM(X) ; Conversion
  1. ;
  1. ; Input:
  1. ; X - external date or FileMan Date
  1. ;
  1. ; Output:
  1. ; Y - FileMan Date or -1
  1. ;
  1. N Y
  1. S X=$G(X)
  1. D ^%DT
  1. K X,%DT
  1. Q Y
  1. ;
  1. ;
  1. PSOVGTADDR(PSOVRTN,PSOVICN,PSOVATYP) ; Retrieve address in Patient file (#2)
  1. ;
  1. ; Input: PSOVICN (required) - Patient ICN
  1. ; PSOVATYP (required) - Indicator of which address is to be retrieved
  1. ; T - temporary address
  1. ; O - Other, yet to be determined
  1. ; Output: PSOVRTN - Return Value
  1. ; temporary address in json format
  1. ; -1 - error message for failure
  1. ;
  1. ;
  1. ; check for required input parameters
  1. I $G(PSOVICN)="" S PSOVRTN="-1 - ICN is required" Q
  1. I '$D(PSOVATYP) S PSOVRTN="-1 - Address type is required" Q
  1. ;
  1. ; check ICN is valid
  1. N DFN
  1. S DFN=$$GETDFN^MPIF001(PSOVICN)
  1. ;
  1. I +DFN=-1 S PSOVRTN="-1 - ICN not recognised" Q
  1. ;
  1. N QUERY
  1. S QUERY("PATIENT")=DFN
  1. N PSOVTMP D GET^DDE("PSO TEMPORARY ADDRESS",DFN,,0,,"PSOVTMP")
  1. S PSOVRTN=$G(PSOVTMP(1))
  1. I PSOVRTN="" S PSOVRTN="0 - No data - there is no temporary address data for ICN "_PSOVICN
  1. Q
  1. ;
  1. CNTCHK(CNTRY) ;
  1. ;
  1. N COUNTRY
  1. S COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"D","","ERROR")
  1. I COUNTRY=0 D
  1. .S COUNTRY=$$FIND1^DIC(779.004,"","MX",CNTRY,"B","","ERROR")
  1. Q COUNTRY
  1. ;
  1. ; --------
  1. ;
  1. ECME(PSOVO,PSOVRXN) ; ECME Log
  1. ;
  1. ; Input: PSOVRXN (required) - Prescription number
  1. ;
  1. ; Output: PSOVRTN - Return Value
  1. ; ECME log in json format
  1. ; -1 - error message for failure
  1. ;
  1. ; check for required input parameters
  1. I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q
  1. ;
  1. I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q
  1. N ERR,PSOVIEN
  1. S PSOVIEN=$O(^TMP($J,"PSOV",-1))
  1. D GET^DDE("PSO ECME M",PSOVIEN,,0,,"PSOVO","ERR")
  1. I $D(ERR) D NORXNER("-1^Error in Retrieval") Q
  1. I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no ECME entries for this prescription") Q
  1. D TIDY()
  1. Q
  1. ;
  1. ; ---------
  1. ;
  1. ERX(PSOVO,PSOVRXN) ; eRx Log
  1. ;
  1. ; Input: PSOVRXN (required) - Prescription number
  1. ;
  1. ; Output: PSOVRTN - Return Value
  1. ; ERX log in json format
  1. ; -1 - error message for failure
  1. ;
  1. ; check for required input parameters
  1. I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q
  1. ;
  1. I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q
  1. N ERR,PSOVIEN
  1. S PSOVIEN=$O(^TMP($J,"PSOV",-1))
  1. ;
  1. D GET^DDE("PSO ERX M",PSOVIEN,,0,,"PSOVO","ERR")
  1. I $D(ERR) D NORXNER("-1^Error in Retrieval") Q
  1. I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no ERX entries for this prescription") Q
  1. D TIDY()
  1. Q
  1. ;
  1. ; --------
  1. ;
  1. LELF(PSOVO,PSOVRXN) ; Lot/Expiration Log File
  1. ;
  1. ; Input: PSOVRXN (required) - Prescription number
  1. ;
  1. ; Output: PSOVRTN - Return Value
  1. ; Lot/Expiration log in json format
  1. ; -1 - error message for failure
  1. ;
  1. ; check for required input parameters
  1. I $G(PSOVRXN)="" D NORXNER("-1 - Prescription number is required") Q
  1. ;
  1. I '$$RXVAL^PSOUTCRM(PSOVRXN) D NORXNER("-2^ Prescription Number is not recognized") Q
  1. N ERR,PSOVIEN
  1. S PSOVIEN=$O(^TMP($J,"PSOV",-1))
  1. ;
  1. D GET^DDE("PSO LOT EXP M",PSOVIEN,,0,,"PSOVO","ERR")
  1. I $D(ERR) D NORXNER("-1^Error in Retrieval") Q
  1. I $L(PSOVO(1),"}")<3 D NORXNER("0^No data - there are no Lot_Expiration entries for this prescription") Q
  1. D TIDY()
  1. Q
  1. ;
  1. ; --------
  1. NORXNER(ERROR) ; handle messages for input parameter issue or no data
  1. ;
  1. N ZXC,PSOVRT
  1. S PSOVRT="PSOVO"
  1. S ECMER=ERROR
  1. D MERGE(0)
  1. K PSOVO(0)
  1. K PSOVO(1)
  1. D ENCODE^XLFJSON("ECM",.PSOVRT)
  1. S ZXC=@(PSOVRT_"(1)")
  1. S ZXC=$$SWAP^PSOUTCRM(ZXC,"\/","/")
  1. S @PSOVRT=ZXC
  1. K ECM,ECMER
  1. Q
  1. ;
  1. ;
  1. TRNSFRM(X,SEP,BRC) ; remove extra quotes from string
  1. ;
  1. ; X - string processes
  1. ; SEP - delimiter on which string is parsed
  1. ; BRC - opening or closing curly brace
  1. ;
  1. Q $P(X,SEP)_SEP_""":"_BRC_$P(X,BRC,4,$L(X,BRC))
  1. ;
  1. TIDY() ; tidy up output string
  1. ;
  1. S PSOVO(1)="{"_$P(PSOVO(1),"{",2,$L(PSOVO(1),"{"))
  1. N PSOVA1,PSOVA2,CT
  1. S CT=$L(PSOVO(1),"}, {")
  1. M PSOVA1=PSOVO(1)
  1. M PSOVA2("data","items")=PSOVA1
  1. S PSOVA2("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($H))
  1. S PSOVA2("data","total items")=CT
  1. D ENCODE^XLFJSON("PSOVA2","PSOVO")
  1. S PSOVO(1)=$TR(PSOVO(1),"\\\")
  1. S PSOVO=$$CHOP(PSOVO(1))
  1. K PSOVO(0)
  1. ;
  1. S PSOVO=$$TRNSFRM(PSOVO,"items","{")
  1. S PSOVO=$RE($$TRNSFRM($RE(PSOVO),"smeti latot","}"))
  1. S PSOVO=$RE($P($RE(PSOVO),":",1,3)_","_$P($RE(PSOVO),":",4,$L($RE(PSOVO),":")))
  1. ;
  1. Q
  1. ;
  1. MERGE(CT) ; merge into output array as json
  1. ;
  1. M ECM("data","items")=ECMER
  1. S ECM("data","updated")=$$FMTHL7^XLFDT($$HTFM^XLFDT($H))
  1. S ECM("data","total items")=CT
  1. Q
  1. ;
  1. ;
  1. NTOS(X) ; convert numbers to strings
  1. ;
  1. N W,Y,L,M,I
  1. S L=$P(X,":",1),M=$TR($P(X,":",2,$L(X,":")),"][")
  1. S W=$P($P(X,"[",2),"]",1)
  1. F I=1:1:$L(W,", ") I $P(W,", ",I)=+$P(W,", ",I) D
  1. .S $P(M,", ",I)=""""_$P(M,", ",I)_""""
  1. S $P(L,":",2)="["_M_"]"
  1. Q L
  1. ;
  1. CHOP(S) ; remove "\ and \" from input S
  1. N P,B,C,I
  1. S P="""\"
  1. S B="" F I=1:1:$L(S,P) S B=B_$P(S,P,I)
  1. S P="\"""
  1. S C="" F I=1:1:$L(B,P) S C=C_$P(B,P,I)
  1. Q C
  1. ;