- DVBCBULL ;ALB/GTS - 557/THM-SEND CANCELLATION BULLETIN ; 6/25/91 11:01 AM
- ;;2.7;AMIE;**42,184,189,193**;Apr 10, 1995;Build 84
- ;
- N MSG1,MERR1,CNT1,MSG2,MERR2,CNT2,RIEN
- K ^TMP("DVBC","BULL",$J),^TMP("DVBC","CMNT",$J) S DIC="^TMP(""DVBC"",""CMNT"",$J,99,",DWPK=1 W @IOF,!!,"Cancellation comments:",!! D EN^DIWE
- K DWPK I $O(^TMP("DVBC","CMNT",$J,99,0))]"" S ^TMP("DVBC","BULL",$J,98,0)=" ",^TMP("DVBC","BULL",$J,97,0)="==========================< Additional comments >=========================="
- F I=0:0 S I=$O(^TMP("DVBC","CMNT",$J,99,I)) Q:I="" S ^TMP("DVBC","BULL",$J,(I+99),0)=^TMP("DVBC","CMNT",$J,99,I,0)
- K ^TMP("DVBC","CMNT",$J) S $P(DOTS,".",45)="." W !!,"A bulletin will now be sent to the 2507 Cancellation mail group.",!
- ;
- ;Build Claim Type Info
- S RIEN=DA
- K ^TMP($J,"DVBCBULL","CT")
- N MSG1,MERR1,CTR1
- S (MSG1,MERR1)="",CTR1=1
- D GETS^DIQ(396.3,RIEN_",","9.1*","E","MSG1","MERR1")
- I $G(MERR1)'="" S ^TMP($J,"DVBCBULL","CT",CTR1)="ERROR GETTING CLAIM TYPE CODES"
- S J=""
- F S J=$O(MSG1(396.32,J)) Q:J="" D
- . S CTR1=CTR1+1
- . S ^TMP($J,"DVBCBULL","CT",CTR1)=$G(MSG1(396.32,J,.01,"E"))
- ;
- ;Build Special Considerations Info
- K ^TMP($J,"DVBCBULL","SC")
- N MSG2,MERR2,CTR2
- S (MSG2,MERR2)="",CTR2=1
- D GETS^DIQ(396.3,RIEN,"50*","IE","MSG2","MERR2")
- I $G(MERR2)'="" S ^TMP($J,"DVBCBULL","SC",CTR2)="ERROR GETTING SPECIAL CONSIDERATION CODES"
- S J=""
- F S J=$O(MSG2(396.31,J)) Q:J="" D
- . S CTR2=CTR2+1
- . S ^TMP($J,"DVBCBULL","SC",CTR2)=$G(MSG2(396.31,J,.01,"E"))
- ;
- GO S L=1,^TMP("DVBC","BULL",$J,L,0)="The following veteran had one or more 2507 exams cancelled:",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" DFN: `"_DFN_$E(" ",1,20-$L(DFN))_"SITE: "_DVBCSITE,L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" REQUEST DATE: "_DVBCRDAT,L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" Claim Type:",L=L+1
- F S J=$O(^TMP($J,"DVBCBULL","CT",J)) Q:J="" D
- . S ^TMP("DVBC","BULL",$J,L,0)=" "_^TMP($J,"DVBCBULL","CT",J),L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" Special Consideration(s):",L=L+1
- S J=""
- F S J=$O(^TMP($J,"DVBCBULL","SC",J)) Q:J="" D
- . S ^TMP("DVBC","BULL",$J,L,0)=" "_^TMP($J,"DVBCBULL","SC",J),L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)="Exams cancelled Reason",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S EXAM="",RSTAT=$P(^DVB(396.3,REQDA,0),U,18)
- ;AJF;Request Status conversion
- S RSTAT=$$RSTAT^DVBCUTL8(RSTAT)
- F JI=0:0 S EXAM=$O(CANC(EXAM)) Q:EXAM="" I $P(CANC(EXAM),U,1)="X"!($P(CANC(EXAM),U,1)="RX") S REAS=+$P(CANC(EXAM),U,2) D EXAMS
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1,COMP=1,CMPC=0
- ;
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)="** NOTE: To view the patient using the DFN, paste the DFN number into the **",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)="** CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to **",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)="** include the ' (backward-apostrophe) character. **",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- ;
- K ^TMP("DVBC","CMNT",$J)
- I RSTAT["X" S ^TMP("DVBC","BULL",$J,L,0)=" *** All exams on this request are now CANCELLED. ***",L=L+1,^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
- S ^TMP("DVBC","BULL",$J,L,0)="** This is an auto-generated email. Do not respond to this email address. **",L=L+1
- G SEND
- S ECNT=0
- F JZ=0:0 S JZ=$O(^DVB(396.4,"C",REQDA,JZ)) Q:JZ="" S STAT=$P(^DVB(396.4,JZ,0),U,4) S:STAT="C" CMPC=1 I STAT'="C"&(STAT'["X") S COMP=0,ECNT=ECNT+1
- ;CMPC=completed exam COMP=open exam
- ;both are toggled, depending on exam status. Both must be 1 to put release banner on message
- I RSTAT'["X",COMP=0 S ^TMP("DVBC","BULL",$J,L,0)=" *** There "_$S(ECNT=1:"is",1:"are")_" still "_ECNT_" exam"_$S(ECNT=1:"",1:"s")_" open on this request. ***",L=L+1,^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1 G SEND
- I COMP=1&(CMPC=1),RSTAT'["X" S ^TMP("DVBC","BULL",$J,L,0)=" *** This request is now COMPLETE and should be released by MAS ***",L=L+1
- I COMP=1&(CMPC=1),RSTAT'["X" S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1 ;spacer
- ;
- SEND ;remote sites get bulletins only on total cancellations
- S DIC="^XMB(3.8,",DIC(0)="QM",X="DVBA C 2507 CANCELLATION" D ^DIC S MG=+Y I +Y<0 W !!,*7,"2507 mail group NOT found! Bulletin not sent.",!! H 3 Q
- F JI=0:0 S JI=$O(^XMB(3.8,MG,1,"B",JI)) Q:JI="" S XMY(JI)=""
- F JI=0:0 S JI=$O(XMY(JI)) Q:JI=""!(+JI=0) I '$D(^VA(200,JI,2,+REQRO))&'$D(^VA(200,JI,2,+REQRO))&('$D(^XUSEC("DVBA C SUPERVISOR",JI))) K XMY(JI)
- S:REQSTR="" REQSTR=.5 S XMY(REQSTR)="",XMY(DUZ)="",XMSUB="Cancellation of 2507 Exams",XMTEXT="^TMP(""DVBC"",""BULL"",$J,",XMDUZ=DUZ
- I '$D(^VA(200,DUZ,.15)) S XMY(XMDUZ)="" G XMD
- I $D(^VA(200,DUZ,.15))&($P(^VA(200,DUZ,.15),"^",1)="") S XMY(XMDUZ)="" G XMD
- I $D(^VA(200,DUZ,.15)) S XMY($P(^VA(200,DUZ,.15),"^",1))=""
- XMD D ^XMD
- K ^TMP("DVBC","BULL",$J),XMDUZ,DOTS,COMP,CMPC,XEXAM,REASON,L,JI,JY,XMY,XMSUB,XMTEXT,XMDUZ,ECNT
- K ^TMP($J,"DVBCBULL","CT"),^TMP($J,"DVBCBULL","SC")
- Q
- ;
- EXAMS S REASON=$S($D(^DVB(396.5,+REAS,0)):$P(^(0),U,1),1:"Undetermined")
- S XEXAM=$E(EXAM,1,25),^TMP("DVBC","BULL",$J,L,0)=" "_XEXAM_" "_$E(DOTS,1,35-$L(XEXAM))_" "_REASON S L=L+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCBULL 5354 printed Apr 23, 2025@17:58:10 Page 2
- DVBCBULL ;ALB/GTS - 557/THM-SEND CANCELLATION BULLETIN ; 6/25/91 11:01 AM
- +1 ;;2.7;AMIE;**42,184,189,193**;Apr 10, 1995;Build 84
- +2 ;
- +3 NEW MSG1,MERR1,CNT1,MSG2,MERR2,CNT2,RIEN
- +4 KILL ^TMP("DVBC","BULL",$JOB),^TMP("DVBC","CMNT",$JOB)
- SET DIC="^TMP(""DVBC"",""CMNT"",$J,99,"
- SET DWPK=1
- WRITE @IOF,!!,"Cancellation comments:",!!
- DO EN^DIWE
- +5 KILL DWPK
- IF $ORDER(^TMP("DVBC","CMNT",$JOB,99,0))]""
- SET ^TMP("DVBC","BULL",$JOB,98,0)=" "
- SET ^TMP("DVBC","BULL",$JOB,97,0)="==========================< Additional comments >=========================="
- +6 FOR I=0:0
- SET I=$ORDER(^TMP("DVBC","CMNT",$JOB,99,I))
- if I=""
- QUIT
- SET ^TMP("DVBC","BULL",$JOB,(I+99),0)=^TMP("DVBC","CMNT",$JOB,99,I,0)
- +7 KILL ^TMP("DVBC","CMNT",$JOB)
- SET $PIECE(DOTS,".",45)="."
- WRITE !!,"A bulletin will now be sent to the 2507 Cancellation mail group.",!
- +8 ;
- +9 ;Build Claim Type Info
- +10 SET RIEN=DA
- +11 KILL ^TMP($JOB,"DVBCBULL","CT")
- +12 NEW MSG1,MERR1,CTR1
- +13 SET (MSG1,MERR1)=""
- SET CTR1=1
- +14 DO GETS^DIQ(396.3,RIEN_",","9.1*","E","MSG1","MERR1")
- +15 IF $GET(MERR1)'=""
- SET ^TMP($JOB,"DVBCBULL","CT",CTR1)="ERROR GETTING CLAIM TYPE CODES"
- +16 SET J=""
- +17 FOR
- SET J=$ORDER(MSG1(396.32,J))
- if J=""
- QUIT
- Begin DoDot:1
- +18 SET CTR1=CTR1+1
- +19 SET ^TMP($JOB,"DVBCBULL","CT",CTR1)=$GET(MSG1(396.32,J,.01,"E"))
- End DoDot:1
- +20 ;
- +21 ;Build Special Considerations Info
- +22 KILL ^TMP($JOB,"DVBCBULL","SC")
- +23 NEW MSG2,MERR2,CTR2
- +24 SET (MSG2,MERR2)=""
- SET CTR2=1
- +25 DO GETS^DIQ(396.3,RIEN,"50*","IE","MSG2","MERR2")
- +26 IF $GET(MERR2)'=""
- SET ^TMP($JOB,"DVBCBULL","SC",CTR2)="ERROR GETTING SPECIAL CONSIDERATION CODES"
- +27 SET J=""
- +28 FOR
- SET J=$ORDER(MSG2(396.31,J))
- if J=""
- QUIT
- Begin DoDot:1
- +29 SET CTR2=CTR2+1
- +30 SET ^TMP($JOB,"DVBCBULL","SC",CTR2)=$GET(MSG2(396.31,J,.01,"E"))
- End DoDot:1
- +31 ;
- GO SET L=1
- SET ^TMP("DVBC","BULL",$JOB,L,0)="The following veteran had one or more 2507 exams cancelled:"
- SET L=L+1
- +1 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +2 SET ^TMP("DVBC","BULL",$JOB,L,0)=" DFN: `"_DFN_$EXTRACT(" ",1,20-$LENGTH(DFN))_"SITE: "_DVBCSITE
- SET L=L+1
- +3 SET ^TMP("DVBC","BULL",$JOB,L,0)=" REQUEST DATE: "_DVBCRDAT
- SET L=L+1
- +4 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +5 SET ^TMP("DVBC","BULL",$JOB,L,0)=" Claim Type:"
- SET L=L+1
- +6 FOR
- SET J=$ORDER(^TMP($JOB,"DVBCBULL","CT",J))
- if J=""
- QUIT
- Begin DoDot:1
- +7 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_^TMP($JOB,"DVBCBULL","CT",J)
- SET L=L+1
- End DoDot:1
- +8 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +9 SET ^TMP("DVBC","BULL",$JOB,L,0)=" Special Consideration(s):"
- SET L=L+1
- +10 SET J=""
- +11 FOR
- SET J=$ORDER(^TMP($JOB,"DVBCBULL","SC",J))
- if J=""
- QUIT
- Begin DoDot:1
- +12 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_^TMP($JOB,"DVBCBULL","SC",J)
- SET L=L+1
- End DoDot:1
- +13 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +14 SET ^TMP("DVBC","BULL",$JOB,L,0)="Exams cancelled Reason"
- SET L=L+1
- +15 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +16 SET EXAM=""
- SET RSTAT=$PIECE(^DVB(396.3,REQDA,0),U,18)
- +17 ;AJF;Request Status conversion
- +18 SET RSTAT=$$RSTAT^DVBCUTL8(RSTAT)
- +19 FOR JI=0:0
- SET EXAM=$ORDER(CANC(EXAM))
- if EXAM=""
- QUIT
- IF $PIECE(CANC(EXAM),U,1)="X"!($PIECE(CANC(EXAM),U,1)="RX")
- SET REAS=+$PIECE(CANC(EXAM),U,2)
- DO EXAMS
- +20 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- SET COMP=1
- SET CMPC=0
- +21 ;
- +22 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +23 SET ^TMP("DVBC","BULL",$JOB,L,0)="** NOTE: To view the patient using the DFN, paste the DFN number into the **"
- SET L=L+1
- +24 SET ^TMP("DVBC","BULL",$JOB,L,0)="** CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to **"
- SET L=L+1
- +25 SET ^TMP("DVBC","BULL",$JOB,L,0)="** include the ' (backward-apostrophe) character. **"
- SET L=L+1
- +26 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +27 ;
- +28 KILL ^TMP("DVBC","CMNT",$JOB)
- +29 IF RSTAT["X"
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" *** All exams on this request are now CANCELLED. ***"
- SET L=L+1
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +30 SET ^TMP("DVBC","BULL",$JOB,L,0)="** This is an auto-generated email. Do not respond to this email address. **"
- SET L=L+1
- +31 GOTO SEND
- +32 SET ECNT=0
- +33 FOR JZ=0:0
- SET JZ=$ORDER(^DVB(396.4,"C",REQDA,JZ))
- if JZ=""
- QUIT
- SET STAT=$PIECE(^DVB(396.4,JZ,0),U,4)
- if STAT="C"
- SET CMPC=1
- IF STAT'="C"&(STAT'["X")
- SET COMP=0
- SET ECNT=ECNT+1
- +34 ;CMPC=completed exam COMP=open exam
- +35 ;both are toggled, depending on exam status. Both must be 1 to put release banner on message
- +36 IF RSTAT'["X"
- IF COMP=0
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" *** There "_$SELECT(ECNT=1:"is",1:"are")_" still "_ECNT_" exam"_$SELECT(ECNT=1:"",1:"s")_" open on this request. ***"
- SET L=L+1
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- GOTO SEND
- +37 IF COMP=1&(CMPC=1)
- IF RSTAT'["X"
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" *** This request is now COMPLETE and should be released by MAS ***"
- SET L=L+1
- +38 ;spacer
- IF COMP=1&(CMPC=1)
- IF RSTAT'["X"
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
- SET L=L+1
- +39 ;
- SEND ;remote sites get bulletins only on total cancellations
- +1 SET DIC="^XMB(3.8,"
- SET DIC(0)="QM"
- SET X="DVBA C 2507 CANCELLATION"
- DO ^DIC
- SET MG=+Y
- IF +Y<0
- WRITE !!,*7,"2507 mail group NOT found! Bulletin not sent.",!!
- HANG 3
- QUIT
- +2 FOR JI=0:0
- SET JI=$ORDER(^XMB(3.8,MG,1,"B",JI))
- if JI=""
- QUIT
- SET XMY(JI)=""
- +3 FOR JI=0:0
- SET JI=$ORDER(XMY(JI))
- if JI=""!(+JI=0)
- QUIT
- IF '$DATA(^VA(200,JI,2,+REQRO))&'$DATA(^VA(200,JI,2,+REQRO))&('$DATA(^XUSEC("DVBA C SUPERVISOR",JI)))
- KILL XMY(JI)
- +4 if REQSTR=""
- SET REQSTR=.5
- SET XMY(REQSTR)=""
- SET XMY(DUZ)=""
- SET XMSUB="Cancellation of 2507 Exams"
- SET XMTEXT="^TMP(""DVBC"",""BULL"",$J,"
- SET XMDUZ=DUZ
- +5 IF '$DATA(^VA(200,DUZ,.15))
- SET XMY(XMDUZ)=""
- GOTO XMD
- +6 IF $DATA(^VA(200,DUZ,.15))&($PIECE(^VA(200,DUZ,.15),"^",1)="")
- SET XMY(XMDUZ)=""
- GOTO XMD
- +7 IF $DATA(^VA(200,DUZ,.15))
- SET XMY($PIECE(^VA(200,DUZ,.15),"^",1))=""
- XMD DO ^XMD
- +1 KILL ^TMP("DVBC","BULL",$JOB),XMDUZ,DOTS,COMP,CMPC,XEXAM,REASON,L,JI,JY,XMY,XMSUB,XMTEXT,XMDUZ,ECNT
- +2 KILL ^TMP($JOB,"DVBCBULL","CT"),^TMP($JOB,"DVBCBULL","SC")
- +3 QUIT
- +4 ;
- EXAMS SET REASON=$SELECT($DATA(^DVB(396.5,+REAS,0)):$PIECE(^(0),U,1),1:"Undetermined")
- +1 SET XEXAM=$EXTRACT(EXAM,1,25)
- SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_XEXAM_" "_$EXTRACT(DOTS,1,35-$LENGTH(XEXAM))_" "_REASON
- SET L=L+1
- +2 QUIT
