VAQBUL04 ;ALB/JRP - BULLETINS;25-MAY-93
;;1.5;PATIENT DATA EXCHANGE;**9**;NOV 17, 1993
RESULTS ;CONTINUATION OF VAQBUL03
; DECLARATIONS DONE IN $$RESULTS^VAQBUL03
;PUT IN COMMENT/REASON
I (STATUS="VAQ-NTFND") D
.S TMP=SPACE_"Reason: Patient not found"
.S @TMPARR@("DISPLAY",LINE,0)=TMP
.S LINE=LINE+1
I (STATUS="VAQ-AMBIG") D
.S TMP=SPACE_"Reason: Requested patient could not be uniquely identified"
.S @TMPARR@("DISPLAY",LINE,0)=TMP
I ((STATUS="VAQ-RSLT")!(STATUS="VAQ-REJ")) D
.;DETERMINE IF COMMENT EXIST
.S COMMENT=0
.S COMMENT=$D(^VAT(394.61,TRANPTR,"CMNT"))
.S:(COMMENT) COMMENT=+$O(^VAT(394.61,TRANPTR,"CMNT",0))
.;NO COMMENT/REASON
.I ('COMMENT) D
..S TMP=SPACE_$S((STATUS="VAQ-RSLT"):"Comments: ",1:"Reason: ")_"None listed"
..S @TMPARR@("DISPLAY",LINE,0)=TMP
..S LINE=LINE+1
.;COMMENT/REASON
.I (COMMENT) D
..S TMP=SPACE_$S((STATUS="VAQ-RSLT"):"Comments:",1:"Reason:")
..S @TMPARR@("DISPLAY",LINE,0)=TMP
..S LINE=LINE+1
..;FORMAT TEXT
..K ^UTILITY($J,"W")
..S OFFSET=0
..F S OFFSET=+$O(^VAT(394.61,TRANPTR,"CMNT",OFFSET)) Q:('OFFSET) D
...S X=$G(^VAT(394.61,TRANPTR,"CMNT",OFFSET,0))
...S DIWL=0
...S DIWR=0
...S DIWF="I"_$L(SPACE)_"C75"
...D ^DIWP
..;PUT COMMENT/REASON INTO MESSAGE
..S OFFSET=""
..F S OFFSET=$O(^UTILITY($J,"W",0,OFFSET)) Q:(OFFSET="") D
...S TMP=$G(^UTILITY($J,"W",0,OFFSET,0))
...S @TMPARR@("DISPLAY",LINE,0)=TMP
...S LINE=LINE+1
..K ^UTILITY($J,"W")
;PUT IN DATA
I ('SENSITVE) I (STATUS="VAQ-RSLT") I (+$G(^VAT(394.61,TRANPTR,"NTFY1"))) D
.F X=1:1:3 S @TMPARR@("DISPLAY",LINE,0)="",LINE=LINE+1
.S TMP=SPACE_"Requested information:"
.S @TMPARR@("DISPLAY",LINE,0)=TMP
.S LINE=LINE+1
.F X=1:1:3 S @TMPARR@("DISPLAY",LINE,0)="",LINE=LINE+1
.S X=$$TRNDSP^VAQUPD2(TRANPTR,TMPARR,LINE)
.;SUCCESS
.I (X>0) S LINE=LINE+X Q
.;NO DATA
.S LINE=LINE-4
.S TMP=SPACE_"Requested data could not be included in notification"
.S @TMPARR@("DISPLAY",LINE,0)=TMP
.S LINE=LINE+1
.I ('X) D Q
..S TMP=SPACE_"Transaction did not contain any information"
..S @TMPARR@("DISPLAY",LINE,0)=TMP
..S LINE=LINE+1
.;ERROR
.I (X<0) D Q
..S @TMPARR@("DISPLAY",LINE,0)=SPACE_"Error occurred while getting information from PDX files"
..S LINE=LINE+1
..S @TMPARR@("DISPLAY",LINE,0)=SPACE_$P(X,"^",2)
..S LINE=LINE+1
.F X=1:1:2 S @TMPARR@("DISPLAY",LINE,0)="",LINE=LINE+1
;PLACE "DISPLAY" INTO ROOT
S TMP=$P(TMPARR,"(",1)
S X=$P(TMPARR,"(",2)
S Y=$P(X,")",1)
S:(Y="") TMPROOT=TMP_"("_$C(34)_"DISPLAY"_$C(34)_")"
S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_"DISPLAY"_$C(34)_")"
S:(TMPARR="") TMPROOT=""
;BUILD DISTRIBUTION LIST
S X=""
F S X=+$O(^VAT(394.61,TRANPTR,"NTFY2","B",X)) Q:('X) S XMY(X)=""
;INCLUDE SECURITY OFFICER IF PATIENT IS SENSITIVE AT REMOTE FACILITY
S:(SENSITVE) X=$$LOADXMY^DGSEC()
;SEND BULLETIN
S TMP="PDX Rejection for "_NAME
S:(STATUS="VAQ-RSLT") TMP="PDX Results for "_NAME
S X="PDX"
S Y="Patient Data eXchange"
S ERROR=$$SENDBULL^VAQBUL(TMP,X,Y,TMPROOT)
Q:(ERROR<0)
S ERROR=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQBUL04 3076 printed Dec 13, 2024@02:24:38 Page 2
VAQBUL04 ;ALB/JRP - BULLETINS;25-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**9**;NOV 17, 1993
RESULTS ;CONTINUATION OF VAQBUL03
+1 ; DECLARATIONS DONE IN $$RESULTS^VAQBUL03
+2 ;PUT IN COMMENT/REASON
+3 IF (STATUS="VAQ-NTFND")
Begin DoDot:1
+4 SET TMP=SPACE_"Reason: Patient not found"
+5 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+6 SET LINE=LINE+1
End DoDot:1
+7 IF (STATUS="VAQ-AMBIG")
Begin DoDot:1
+8 SET TMP=SPACE_"Reason: Requested patient could not be uniquely identified"
+9 SET @TMPARR@("DISPLAY",LINE,0)=TMP
End DoDot:1
+10 IF ((STATUS="VAQ-RSLT")!(STATUS="VAQ-REJ"))
Begin DoDot:1
+11 ;DETERMINE IF COMMENT EXIST
+12 SET COMMENT=0
+13 SET COMMENT=$DATA(^VAT(394.61,TRANPTR,"CMNT"))
+14 if (COMMENT)
SET COMMENT=+$ORDER(^VAT(394.61,TRANPTR,"CMNT",0))
+15 ;NO COMMENT/REASON
+16 IF ('COMMENT)
Begin DoDot:2
+17 SET TMP=SPACE_$SELECT((STATUS="VAQ-RSLT"):"Comments: ",1:"Reason: ")_"None listed"
+18 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+19 SET LINE=LINE+1
End DoDot:2
+20 ;COMMENT/REASON
+21 IF (COMMENT)
Begin DoDot:2
+22 SET TMP=SPACE_$SELECT((STATUS="VAQ-RSLT"):"Comments:",1:"Reason:")
+23 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+24 SET LINE=LINE+1
+25 ;FORMAT TEXT
+26 KILL ^UTILITY($JOB,"W")
+27 SET OFFSET=0
+28 FOR
SET OFFSET=+$ORDER(^VAT(394.61,TRANPTR,"CMNT",OFFSET))
if ('OFFSET)
QUIT
Begin DoDot:3
+29 SET X=$GET(^VAT(394.61,TRANPTR,"CMNT",OFFSET,0))
+30 SET DIWL=0
+31 SET DIWR=0
+32 SET DIWF="I"_$LENGTH(SPACE)_"C75"
+33 DO ^DIWP
End DoDot:3
+34 ;PUT COMMENT/REASON INTO MESSAGE
+35 SET OFFSET=""
+36 FOR
SET OFFSET=$ORDER(^UTILITY($JOB,"W",0,OFFSET))
if (OFFSET="")
QUIT
Begin DoDot:3
+37 SET TMP=$GET(^UTILITY($JOB,"W",0,OFFSET,0))
+38 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+39 SET LINE=LINE+1
End DoDot:3
+40 KILL ^UTILITY($JOB,"W")
End DoDot:2
End DoDot:1
+41 ;PUT IN DATA
+42 IF ('SENSITVE)
IF (STATUS="VAQ-RSLT")
IF (+$GET(^VAT(394.61,TRANPTR,"NTFY1")))
Begin DoDot:1
+43 FOR X=1:1:3
SET @TMPARR@("DISPLAY",LINE,0)=""
SET LINE=LINE+1
+44 SET TMP=SPACE_"Requested information:"
+45 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+46 SET LINE=LINE+1
+47 FOR X=1:1:3
SET @TMPARR@("DISPLAY",LINE,0)=""
SET LINE=LINE+1
+48 SET X=$$TRNDSP^VAQUPD2(TRANPTR,TMPARR,LINE)
+49 ;SUCCESS
+50 IF (X>0)
SET LINE=LINE+X
QUIT
+51 ;NO DATA
+52 SET LINE=LINE-4
+53 SET TMP=SPACE_"Requested data could not be included in notification"
+54 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+55 SET LINE=LINE+1
+56 IF ('X)
Begin DoDot:2
+57 SET TMP=SPACE_"Transaction did not contain any information"
+58 SET @TMPARR@("DISPLAY",LINE,0)=TMP
+59 SET LINE=LINE+1
End DoDot:2
QUIT
+60 ;ERROR
+61 IF (X<0)
Begin DoDot:2
+62 SET @TMPARR@("DISPLAY",LINE,0)=SPACE_"Error occurred while getting information from PDX files"
+63 SET LINE=LINE+1
+64 SET @TMPARR@("DISPLAY",LINE,0)=SPACE_$PIECE(X,"^",2)
+65 SET LINE=LINE+1
End DoDot:2
QUIT
+66 FOR X=1:1:2
SET @TMPARR@("DISPLAY",LINE,0)=""
SET LINE=LINE+1
End DoDot:1
+67 ;PLACE "DISPLAY" INTO ROOT
+68 SET TMP=$PIECE(TMPARR,"(",1)
+69 SET X=$PIECE(TMPARR,"(",2)
+70 SET Y=$PIECE(X,")",1)
+71 if (Y="")
SET TMPROOT=TMP_"("_$CHAR(34)_"DISPLAY"_$CHAR(34)_")"
+72 if (Y'="")
SET TMPROOT=TMP_"("_Y_","_$CHAR(34)_"DISPLAY"_$CHAR(34)_")"
+73 if (TMPARR="")
SET TMPROOT=""
+74 ;BUILD DISTRIBUTION LIST
+75 SET X=""
+76 FOR
SET X=+$ORDER(^VAT(394.61,TRANPTR,"NTFY2","B",X))
if ('X)
QUIT
SET XMY(X)=""
+77 ;INCLUDE SECURITY OFFICER IF PATIENT IS SENSITIVE AT REMOTE FACILITY
+78 if (SENSITVE)
SET X=$$LOADXMY^DGSEC()
+79 ;SEND BULLETIN
+80 SET TMP="PDX Rejection for "_NAME
+81 if (STATUS="VAQ-RSLT")
SET TMP="PDX Results for "_NAME
+82 SET X="PDX"
+83 SET Y="Patient Data eXchange"
+84 SET ERROR=$$SENDBULL^VAQBUL(TMP,X,Y,TMPROOT)
+85 if (ERROR<0)
QUIT
+86 SET ERROR=0
+87 QUIT
