YTQRCDB2.m

YTQRCDB2 ;BAL/KTL - MHA CLOUD DATABASE RPC CALLS; 1/25/2017

 ;;5.01;MENTAL HEALTH;**239**;Dec 30, 1994;Build 16

 ;

 ;Reference to VADPT APIs supported by DBIA #10061

 ;Reference to $$SITE^VASITE supported by IA #10112

 ;

 Q

PID2(ARGS,RESULTS) ;Get additional patient demographics

 N DFN,VA,VADM,YSNM,YSDOB,YSAGE,YSSSN,YSSEX,YSSX,YSSIG

 S DFN=$G(ARGS("dfn"))

 I +DFN=0 D SETERROR^YTQRUTL(404,"Bad patient identifier") QUIT

 I '$D(^DPT(DFN,0)) D SETERROR^YTQRUTL(404,"Not Found: "_DFN) QUIT

 D DEM^VADPT,PID^VADPT

 S YSNM=VADM(1)

 S YSDOB=$P(VADM(3),U,2)

 S YSAGE=VADM(4)

 S YSSSN="xxx-xx-"_VA("BID")

 S YSSEX=$P(VADM(5),U,1)

 S YSSX=YSSEX

 S YSSIG=$P($G(VADM(14,5)),U,2)

 S RESULTS("dob")=YSDOB

 S RESULTS("ssn")=YSSSN

 S RESULTS("sex")=YSSEX

 S RESULTS("sigi")=YSSIG

 Q

TZ(ARGS,RESULTS) ;Get timezone

 N HASSITE,SITE,INST,UTC,NN

 S HASSITE=""

 S INST=$$SITE^VASITE,INST=$P(INST,U,3)

 S:+INST'=0 SITE(INST)="",HASSITE=1

 I '$D(SITE) S HASSITE=$$DIV4^XUSER(.SITE,DUZ)

 I 'HASSITE I $G(DUZ(2))]"" S SITE(DUZ(2))=""  ;Use Default site if not explicitly defined.

 I '$D(SITE) D  Q

 . S RESULTS("inst")=""

 . S RESULTS("fileman")=""

 . S RESULTS("external")=""

 . S RESULTS("offset")=""

 . S RESULTS("timezone")=""

 S INST=$O(SITE(""))  ;Use first in list-assume all are in same TZ

 S NN=$$NOW^XLFDT(),UTC=""

 S INST="" F  S INST=$O(SITE(INST)) Q:INST=""!(UTC'="")  D

 . S UTC=$$UTC^DIUTC(NN,,$G(INST),,1)

 . S:UTC<0 UTC=""

 S RESULTS("fileman")=$P(UTC,U)

 S RESULTS("external")=$P(UTC,U,2)

 S RESULTS("offset")=$P(UTC,U,3)

 S RESULTS("timezone")=$P(UTC,U,4)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YTQRCDB2   1604     printed  Apr 09, 2024@21:17:04                                                                                                                                                                                                    Page 2

YTQRCDB2  ;BAL/KTL - MHA CLOUD DATABASE RPC CALLS; 1/25/2017

 +1       ;;5.01;MENTAL HEALTH;**239**;Dec 30, 1994;Build 16

 +2       ;

 +3       ;Reference to VADPT APIs supported by DBIA #10061

 +4       ;Reference to $$SITE^VASITE supported by IA #10112

 +5       ;

 +6        QUIT 

PID2(ARGS,RESULTS) ;Get additional patient demographics

 +1        NEW DFN,VA,VADM,YSNM,YSDOB,YSAGE,YSSSN,YSSEX,YSSX,YSSIG

 +2        SET DFN=$GET(ARGS("dfn"))

 +3        IF +DFN=0

               DO SETERROR^YTQRUTL(404,"Bad patient identifier")

               QUIT 

 +4        IF '$DATA(^DPT(DFN,0))

               DO SETERROR^YTQRUTL(404,"Not Found: "_DFN)

               QUIT 

 +5        DO DEM^VADPT

           DO PID^VADPT

 +6        SET YSNM=VADM(1)

 +7        SET YSDOB=$PIECE(VADM(3),U,2)

 +8        SET YSAGE=VADM(4)

 +9        SET YSSSN="xxx-xx-"_VA("BID")

 +10       SET YSSEX=$PIECE(VADM(5),U,1)

 +11       SET YSSX=YSSEX

 +12       SET YSSIG=$PIECE($GET(VADM(14,5)),U,2)

 +13       SET RESULTS("dob")=YSDOB

 +14       SET RESULTS("ssn")=YSSSN

 +15       SET RESULTS("sex")=YSSEX

 +16       SET RESULTS("sigi")=YSSIG

 +17       QUIT 

TZ(ARGS,RESULTS) ;Get timezone

 +1        NEW HASSITE,SITE,INST,UTC,NN

 +2        SET HASSITE=""

 +3        SET INST=$$SITE^VASITE

           SET INST=$PIECE(INST,U,3)

 +4        if +INST'=0

               SET SITE(INST)=""

               SET HASSITE=1

 +5        IF '$DATA(SITE)

               SET HASSITE=$$DIV4^XUSER(.SITE,DUZ)

 +6       ;Use Default site if not explicitly defined.

           IF 'HASSITE

               IF $GET(DUZ(2))]""

                   SET SITE(DUZ(2))=""

 +7        IF '$DATA(SITE)

               Begin DoDot:1

 +8                SET RESULTS("inst")=""

 +9                SET RESULTS("fileman")=""

 +10               SET RESULTS("external")=""

 +11               SET RESULTS("offset")=""

 +12               SET RESULTS("timezone")=""

               End DoDot:1

               QUIT 

 +13      ;Use first in list-assume all are in same TZ

           SET INST=$ORDER(SITE(""))

 +14       SET NN=$$NOW^XLFDT()

           SET UTC=""

 +15       SET INST=""

           FOR 

               SET INST=$ORDER(SITE(INST))

               if INST=""!(UTC'="")

                   QUIT 

               Begin DoDot:1

 +16               SET UTC=$$UTC^DIUTC(NN,,$GET(INST),,1)

 +17               if UTC<0

                       SET UTC=""

               End DoDot:1

 +18       SET RESULTS("fileman")=$PIECE(UTC,U)

 +19       SET RESULTS("external")=$PIECE(UTC,U,2)

 +20       SET RESULTS("offset")=$PIECE(UTC,U,3)

 +21       SET RESULTS("timezone")=$PIECE(UTC,U,4)

 +22       QUIT