PXVRPC9 ;BPFO/LMT - PCE RPCs for Imm Disclosures ;06/21/16 16:08
;;1.0;PCE PATIENT CARE ENCOUNTER;**216**;Aug 12, 1996;Build 11
;
;
SETDIS(PXRSLT,PXVIMM,PXAGENCY,PXDT,PXTMZONE) ;
;
; Save immunization disclosure information.
;
;Input:
; PXRSLT - Return value passed by reference (Required)
; PXVIMM - V Immunization IEN (Required)
; PXAGENCY - Agency Name this record was disclosed to (Required)
; PXDT - Date/Time this record was disclosed (Required)
; PXTMZONE - Time Zone of the Date/Time (Required)
;
;Returns:
; 0^error message - If we could not save the disclosure information (either the RPC was called
; incorrectly, or the V Immunization IEN did not exist).
; 1 - Successfully saved the disclosure information
; 2^error message - We attempted to save the disclosure information, but encountered an error
; when filing the data to the database.
;
N PXDTI,PXERR,PXFDA,PXFDAIEN,PXFILE,PXFILESUB,PXHR,PXIEN,PXIENS,PXMIN
;
S PXRSLT="0"
;
I '$G(PXVIMM) D Q
. S PXRSLT="0^V Immunization IEN is not valid"
I $G(PXAGENCY)="" D Q
. S PXRSLT="0^Agency is not valid"
I '$G(PXDT) D Q
. S PXRSLT="0^Date/Time is not valid"
D DT^DILF("TX",$G(PXDT),.PXDTI)
I $G(PXDTI)'>0 D Q
. S PXRSLT="0^Date/Time is not valid"
I $G(PXTMZONE)="" D Q
. S PXRSLT="0^Time zone is not valid"
I PXTMZONE?3A,$$GMTDIFF^XMXUTIL1(PXTMZONE)="" D Q
. S PXRSLT="0^Time zone is not valid"
I PXTMZONE'?3A,PXTMZONE'?1(1"-",1"+")4N D Q
. S PXRSLT="0^Time zone is not valid"
;
S PXIEN=+PXVIMM
S PXFILE=$E(PXVIMM,$L(PXVIMM))
S PXFILE=$S(PXFILE="D":9000080.11,1:9000010.11)
; maybe it was deleted after we sent it to DAS
I PXFILE=9000010.11,'$D(^AUPNVIMM(PXIEN,0)) S PXFILE=9000080.11
I PXFILE=9000080.11,'$D(^AUPDVIMM(PXIEN,0)) D Q
. S PXRSLT="0^V Immunization IEN does not exist"
S PXAGENCY=$$AGENCY(PXAGENCY)
I 'PXAGENCY D Q
. S PXRSLT="0^"_$P(PXAGENCY,U,2)
S PXAGENCY=+PXAGENCY
;
; Update date/time, based off timezone differences
D ZONEDIFF^XMXUTIL1(PXTMZONE,.PXHR,.PXMIN)
S PXDTI=$$FMADD^XLFDT(PXDTI,,PXHR,PXMIN)
;
S PXFILESUB=9000010.1182
I PXFILE=9000080.11 S PXFILESUB=9000080.1182
S PXIENS="+1,"_PXIEN_","
S PXFDA(1,PXFILESUB,PXIENS,.01)=PXAGENCY
S PXFDA(1,PXFILESUB,PXIENS,.02)=PXDTI
D UPDATE^DIE("","PXFDA(1)","PXFDAIEN","PXERR")
I $G(PXFDAIEN(1))>0 D Q
. S PXRSLT=1
;
S PXRSLT="2^"_$G(PXERR("DIERR",1,"TEXT",1))
Q
;
AGENCY(PXNAME) ;Get IEN of agency; allow LAYGO
;
N PXERR,PXFDA,PXFDAIEN,PXIEN
;
S PXFDA(1,920.71,"?+1,",.01)=PXNAME
D UPDATE^DIE("E","PXFDA(1)","PXFDAIEN","PXERR")
S PXIEN=$G(PXFDAIEN(1))
I PXIEN>0 Q PXIEN
Q "0^"_$G(PXERR("DIERR",1,"TEXT",1))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC9 2771 printed Apr 09, 2024@21:28:55 Page 2
PXVRPC9 ;BPFO/LMT - PCE RPCs for Imm Disclosures ;06/21/16 16:08
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**216**;Aug 12, 1996;Build 11
+2 ;
+3 ;
SETDIS(PXRSLT,PXVIMM,PXAGENCY,PXDT,PXTMZONE) ;
+1 ;
+2 ; Save immunization disclosure information.
+3 ;
+4 ;Input:
+5 ; PXRSLT - Return value passed by reference (Required)
+6 ; PXVIMM - V Immunization IEN (Required)
+7 ; PXAGENCY - Agency Name this record was disclosed to (Required)
+8 ; PXDT - Date/Time this record was disclosed (Required)
+9 ; PXTMZONE - Time Zone of the Date/Time (Required)
+10 ;
+11 ;Returns:
+12 ; 0^error message - If we could not save the disclosure information (either the RPC was called
+13 ; incorrectly, or the V Immunization IEN did not exist).
+14 ; 1 - Successfully saved the disclosure information
+15 ; 2^error message - We attempted to save the disclosure information, but encountered an error
+16 ; when filing the data to the database.
+17 ;
+18 NEW PXDTI,PXERR,PXFDA,PXFDAIEN,PXFILE,PXFILESUB,PXHR,PXIEN,PXIENS,PXMIN
+19 ;
+20 SET PXRSLT="0"
+21 ;
+22 IF '$GET(PXVIMM)
Begin DoDot:1
+23 SET PXRSLT="0^V Immunization IEN is not valid"
End DoDot:1
QUIT
+24 IF $GET(PXAGENCY)=""
Begin DoDot:1
+25 SET PXRSLT="0^Agency is not valid"
End DoDot:1
QUIT
+26 IF '$GET(PXDT)
Begin DoDot:1
+27 SET PXRSLT="0^Date/Time is not valid"
End DoDot:1
QUIT
+28 DO DT^DILF("TX",$GET(PXDT),.PXDTI)
+29 IF $GET(PXDTI)'>0
Begin DoDot:1
+30 SET PXRSLT="0^Date/Time is not valid"
End DoDot:1
QUIT
+31 IF $GET(PXTMZONE)=""
Begin DoDot:1
+32 SET PXRSLT="0^Time zone is not valid"
End DoDot:1
QUIT
+33 IF PXTMZONE?3A
IF $$GMTDIFF^XMXUTIL1(PXTMZONE)=""
Begin DoDot:1
+34 SET PXRSLT="0^Time zone is not valid"
End DoDot:1
QUIT
+35 IF PXTMZONE'?3A
IF PXTMZONE'?1(1"-",1"+")4N
Begin DoDot:1
+36 SET PXRSLT="0^Time zone is not valid"
End DoDot:1
QUIT
+37 ;
+38 SET PXIEN=+PXVIMM
+39 SET PXFILE=$EXTRACT(PXVIMM,$LENGTH(PXVIMM))
+40 SET PXFILE=$SELECT(PXFILE="D":9000080.11,1:9000010.11)
+41 ; maybe it was deleted after we sent it to DAS
+42 IF PXFILE=9000010.11
IF '$DATA(^AUPNVIMM(PXIEN,0))
SET PXFILE=9000080.11
+43 IF PXFILE=9000080.11
IF '$DATA(^AUPDVIMM(PXIEN,0))
Begin DoDot:1
+44 SET PXRSLT="0^V Immunization IEN does not exist"
End DoDot:1
QUIT
+45 SET PXAGENCY=$$AGENCY(PXAGENCY)
+46 IF 'PXAGENCY
Begin DoDot:1
+47 SET PXRSLT="0^"_$PIECE(PXAGENCY,U,2)
End DoDot:1
QUIT
+48 SET PXAGENCY=+PXAGENCY
+49 ;
+50 ; Update date/time, based off timezone differences
+51 DO ZONEDIFF^XMXUTIL1(PXTMZONE,.PXHR,.PXMIN)
+52 SET PXDTI=$$FMADD^XLFDT(PXDTI,,PXHR,PXMIN)
+53 ;
+54 SET PXFILESUB=9000010.1182
+55 IF PXFILE=9000080.11
SET PXFILESUB=9000080.1182
+56 SET PXIENS="+1,"_PXIEN_","
+57 SET PXFDA(1,PXFILESUB,PXIENS,.01)=PXAGENCY
+58 SET PXFDA(1,PXFILESUB,PXIENS,.02)=PXDTI
+59 DO UPDATE^DIE("","PXFDA(1)","PXFDAIEN","PXERR")
+60 IF $GET(PXFDAIEN(1))>0
Begin DoDot:1
+61 SET PXRSLT=1
End DoDot:1
QUIT
+62 ;
+63 SET PXRSLT="2^"_$GET(PXERR("DIERR",1,"TEXT",1))
+64 QUIT
+65 ;
AGENCY(PXNAME) ;Get IEN of agency; allow LAYGO
+1 ;
+2 NEW PXERR,PXFDA,PXFDAIEN,PXIEN
+3 ;
+4 SET PXFDA(1,920.71,"?+1,",.01)=PXNAME
+5 DO UPDATE^DIE("E","PXFDA(1)","PXFDAIEN","PXERR")
+6 SET PXIEN=$GET(PXFDAIEN(1))
+7 IF PXIEN>0
QUIT PXIEN
+8 QUIT "0^"_$GET(PXERR("DIERR",1,"TEXT",1))
