- 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 Feb 18, 2025@23:50:40 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
