Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQBUL04

VAQBUL04.m

Go to the documentation of this file.
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