- 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 Jan 18, 2025@03:33:07 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))