Released DVBA*2.7*194 SEQ #170 Extracted from mail message **KIDS**:DVBA*2.7*194^ **INSTALL NAME** DVBA*2.7*194 "BLD",10025,0) DVBA*2.7*194^AUTOMATED MED INFO EXCHANGE^0^3151030^y "BLD",10025,1,0) ^^4^4^3150724^ "BLD",10025,1,1,0) This patch will remove PRIORITY OF EXAM (#9) from the CHECK C&P "BLD",10025,1,2,0) FILE INTEGRITY [DVBA C CHECK 2507 INTEGRITY] validation logic and "BLD",10025,1,3,0) filter inactive cancellation reasons while cancelling compensation "BLD",10025,1,4,0) and pension requests/exams. "BLD",10025,4,0) ^9.64PA^^ "BLD",10025,6.3) 5 "BLD",10025,"KRN",0) ^9.67PA^779.2^20 "BLD",10025,"KRN",.4,0) .4 "BLD",10025,"KRN",.401,0) .401 "BLD",10025,"KRN",.402,0) .402 "BLD",10025,"KRN",.403,0) .403 "BLD",10025,"KRN",.5,0) .5 "BLD",10025,"KRN",.84,0) .84 "BLD",10025,"KRN",3.6,0) 3.6 "BLD",10025,"KRN",3.8,0) 3.8 "BLD",10025,"KRN",9.2,0) 9.2 "BLD",10025,"KRN",9.8,0) 9.8 "BLD",10025,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",10025,"KRN",9.8,"NM",1,0) DVBCCHKR^^0^B29025053 "BLD",10025,"KRN",9.8,"NM",2,0) DVBCCNCL^^0^B29391810 "BLD",10025,"KRN",9.8,"NM",3,0) DVBCCNC1^^0^B14689531 "BLD",10025,"KRN",9.8,"NM","B","DVBCCHKR",1) "BLD",10025,"KRN",9.8,"NM","B","DVBCCNC1",3) "BLD",10025,"KRN",9.8,"NM","B","DVBCCNCL",2) "BLD",10025,"KRN",19,0) 19 "BLD",10025,"KRN",19.1,0) 19.1 "BLD",10025,"KRN",101,0) 101 "BLD",10025,"KRN",409.61,0) 409.61 "BLD",10025,"KRN",771,0) 771 "BLD",10025,"KRN",779.2,0) 779.2 "BLD",10025,"KRN",870,0) 870 "BLD",10025,"KRN",8989.51,0) 8989.51 "BLD",10025,"KRN",8989.52,0) 8989.52 "BLD",10025,"KRN",8994,0) 8994 "BLD",10025,"KRN","B",.4,.4) "BLD",10025,"KRN","B",.401,.401) "BLD",10025,"KRN","B",.402,.402) "BLD",10025,"KRN","B",.403,.403) "BLD",10025,"KRN","B",.5,.5) "BLD",10025,"KRN","B",.84,.84) "BLD",10025,"KRN","B",3.6,3.6) "BLD",10025,"KRN","B",3.8,3.8) "BLD",10025,"KRN","B",9.2,9.2) "BLD",10025,"KRN","B",9.8,9.8) "BLD",10025,"KRN","B",19,19) "BLD",10025,"KRN","B",19.1,19.1) "BLD",10025,"KRN","B",101,101) "BLD",10025,"KRN","B",409.61,409.61) "BLD",10025,"KRN","B",771,771) "BLD",10025,"KRN","B",779.2,779.2) "BLD",10025,"KRN","B",870,870) "BLD",10025,"KRN","B",8989.51,8989.51) "BLD",10025,"KRN","B",8989.52,8989.52) "BLD",10025,"KRN","B",8994,8994) "BLD",10025,"QDEF") ^^^^^^^^^^YES "BLD",10025,"QUES",0) ^9.62^^ "BLD",10025,"REQB",0) ^9.611^2^2 "BLD",10025,"REQB",1,0) DVBA*2.7*17^1 "BLD",10025,"REQB",2,0) DVBA*2.7*184^1 "BLD",10025,"REQB","B","DVBA*2.7*17",1) "BLD",10025,"REQB","B","DVBA*2.7*184",2) "MBREQ") 0 "PKG",223,-1) 1^1 "PKG",223,0) AUTOMATED MED INFO EXCHANGE^DVBA^The entire AMIE package 7131/2507. "PKG",223,20,0) ^9.402P^^ "PKG",223,22,0) ^9.49I^1^1 "PKG",223,22,1,0) 2.7^2950410^2950508 "PKG",223,22,1,"PAH",1,0) 194^3151030 "PKG",223,22,1,"PAH",1,1,0) ^^4^4^3151030 "PKG",223,22,1,"PAH",1,1,1,0) This patch will remove PRIORITY OF EXAM (#9) from the CHECK C&P "PKG",223,22,1,"PAH",1,1,2,0) FILE INTEGRITY [DVBA C CHECK 2507 INTEGRITY] validation logic and "PKG",223,22,1,"PAH",1,1,3,0) filter inactive cancellation reasons while cancelling compensation "PKG",223,22,1,"PAH",1,1,4,0) and pension requests/exams. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","DVBCCHKR") 0^1^B29025053^B29016651 "RTN","DVBCCHKR",1,0) DVBCCHKR ;ALB/GTS-557/THM-CHECK C&P REQUEST FOR CRITICAL DATA ; 2/12/03 9:44am "RTN","DVBCCHKR",2,0) ;;2.7;AMIE;**17,194**;Apr 10, 1995;Build 5 "RTN","DVBCCHKR",3,0) ; "RTN","DVBCCHKR",4,0) ;** Version Changes "RTN","DVBCCHKR",5,0) ; 2.7 - GTS/C&P appt links report (Enhc 13) "RTN","DVBCCHKR",6,0) ; "RTN","DVBCCHKR",7,0) S DVBCMAN="" G EN "RTN","DVBCCHKR",8,0) ; "RTN","DVBCCHKR",9,0) CHECK N OLDX "RTN","DVBCCHKR",10,0) S OLDX=X,DTA=^DVB(396.3,DA,0),DTB=$S($D(^DVB(396.3,DA,1)):^(1),1:"") "RTN","DVBCCHKR",11,0) ;RRA DVBA*194 priority of exam no longer populated so remove from validation list "RTN","DVBCCHKR",12,0) Q:$P(DTA,U,18)["X" F XI=2,3,4,18 I $P(^DVB(396.3,DA,0),U,XI)="" S X=X_XI_U "RTN","DVBCCHKR",13,0) I $P(DTB,U,4)="" S X=X_99_U "RTN","DVBCCHKR",14,0) I $O(^DVB(396.4,"C",DA,0))="" S X=X_98_U ;no exams selected "RTN","DVBCCHKR",15,0) S REQDA=DA,NAME=$P(^DPT(DFN,0),U,1) D:STYLEIND'="4" LINKCK "RTN","DVBCCHKR",16,0) I OLDX'=X DO "RTN","DVBCCHKR",17,0) .S:$E(X,$L(X))="^" X=$E(X,1,($L(X)-1)) "RTN","DVBCCHKR",18,0) .S X=X_";"_DA_"~" "RTN","DVBCCHKR",19,0) I X]"" S ^TMP($J,NAME,DFN)=X "RTN","DVBCCHKR",20,0) Q "RTN","DVBCCHKR",21,0) ; "RTN","DVBCCHKR",22,0) PRINT D HDR S NAME="" "RTN","DVBCCHKR",23,0) F XI=0:0 S NAME=$O(^TMP($J,NAME)) Q:NAME=""!($D(DVBCQUIT)) DO "RTN","DVBCCHKR",24,0) .S (DVBAPC,DVBADTA)="" "RTN","DVBCCHKR",25,0) .F DFN=0:0 S DFN=$O(^TMP($J,NAME,DFN)) Q:DFN=""!($D(DVBCQUIT)) DO "RTN","DVBCCHKR",26,0) ..I (IOST?1"C-".E),($Y>(IOSL-9)) D TERM^DVBCUTL3 S:$D(GETOUT) DVBCQUIT="" "RTN","DVBCCHKR",27,0) ..I '$D(DVBCQUIT) DO "RTN","DVBCCHKR",28,0) ...D:($Y>(IOSL-9)) HDR "RTN","DVBCCHKR",29,0) ...D NAMELN ;**Output name "RTN","DVBCCHKR",30,0) ...F DVBAPC=1:1 S DVBADTA=$P(^TMP($J,NAME,DFN),"~",DVBAPC) Q:DVBADTA="" DO "RTN","DVBCCHKR",31,0) ....W ! "RTN","DVBCCHKR",32,0) ....S DTA=$P(DVBADTA,";",1),REQDA=$P(DVBADTA,";",2) ;**DVBADTA=Prob pce "RTN","DVBCCHKR",33,0) ....F DVBCX=1:1 S DVBAY=$P(DTA,U,DVBCX) Q:DVBAY=""!($D(DVBCQUIT)) I DVBAY]"" D PRINT1 "RTN","DVBCCHKR",34,0) .K DVBAPC,DVBADTA "RTN","DVBCCHKR",35,0) I '$D(DVBCQUIT)&(IOST?1"C-".E) D TERM^DVBCUTL3 S:$D(GETOUT) DVBCQUIT="" "RTN","DVBCCHKR",36,0) Q "RTN","DVBCCHKR",37,0) ; "RTN","DVBCCHKR",38,0) PRINT1 I (IOST?1"C-".E),($Y>(IOSL-2)) D TERM^DVBCUTL3 S:$D(GETOUT) DVBCQUIT="" "RTN","DVBCCHKR",39,0) I '$D(DVBCQUIT) DO "RTN","DVBCCHKR",40,0) .I ($Y>(IOSL-2)) D HDR,NAMELN "RTN","DVBCCHKR",41,0) .W ?50,$S(DVBAY=2:"Request date",DVBAY=3:"Regional office number",DVBAY=4:"Requester",DVBAY=10:"Priority of exam",DVBAY=18:"Request status",DVBAY=99:"Routing location",1:"") "RTN","DVBCCHKR",42,0) .W:DVBAY=98 ?50,"** No exams selected **" "RTN","DVBCCHKR",43,0) .W:DVBAY=199 ?50,"** No C&P Appt's linked **" "RTN","DVBCCHKR",44,0) .W ! "RTN","DVBCCHKR",45,0) Q "RTN","DVBCCHKR",46,0) ; "RTN","DVBCCHKR",47,0) EN D HOME^%ZIS S FF=IOF "RTN","DVBCCHKR",48,0) W @FF,!!,"This report will check the 2507 REQUEST file for missing crucial data.",!!,"All requests will be checked and those found missing any of the following",!,"will be reported:",!! "RTN","DVBCCHKR",49,0) W "1) Request date",!,"2) Regional office number",!,"3) Requester",! "RTN","DVBCCHKR",50,0) W "4) Request status",!,"5) Routing location",!,"6) No exams selected" "RTN","DVBCCHKR",51,0) D SETSTYLE "RTN","DVBCCHKR",52,0) W:STYLEIND=4 ! "RTN","DVBCCHKR",53,0) W:STYLEIND'="4" !,"7) Requests older than 3 days without C&P Appt links ",! "RTN","DVBCCHKR",54,0) W ! K PARAMDA "RTN","DVBCCHKR",55,0) ; "RTN","DVBCCHKR",56,0) ASK W "Do you want to continue" S %=2 D YN^DICN G:$D(DTOUT) EXIT "RTN","DVBCCHKR",57,0) I $D(%Y),%Y["?" W !!,"Enter Y to print the report or N to quit.",!! H 2 G ASK "RTN","DVBCCHKR",58,0) I $D(%),%'=1 G EXIT "RTN","DVBCCHKR",59,0) ; "RTN","DVBCCHKR",60,0) DEV W !! S %ZIS="AEQ" D ^%ZIS K %ZIS G:POP EXIT I $D(IO("Q")) S ZTIO=ION,ZTDESC="2507 exam integrity report",ZTRTN="GO^DVBCCHKR" F I="FF" S ZTSAVE(I)="" "RTN","DVBCCHKR",61,0) I D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! G EXIT "RTN","DVBCCHKR",62,0) ; "RTN","DVBCCHKR",63,0) GO D:'$D(STYLEIND) SETSTYLE "RTN","DVBCCHKR",64,0) K ^TMP($J),LN,DVBCQUIT,GETOUT S (ITEMS,PG)=0,$P(LN,"-",80)="-",HD="C & P Exam Integrity Report",DVBCDT=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBCCHKR",65,0) U IO F DFN=0:0 S X="",DFN=$O(^DVB(396.3,"B",DFN)) Q:DFN="" F DA=0:0 S DA=$O(^DVB(396.3,"B",DFN,DA)) Q:DA="" D CHECK "RTN","DVBCCHKR",66,0) I '$D(^TMP($J)) D HDR W !!!!!?25,"Nothing found to report",!! "RTN","DVBCCHKR",67,0) I $D(^TMP($J)) D PRINT "RTN","DVBCCHKR",68,0) I ('$D(^TMP("DVBA",$J))&((+STYLEIND'="4")&(+$$RPTCHK=1))) DO "RTN","DVBCCHKR",69,0) .D NOW^%DTC S Y=X X ^DD("DD") "RTN","DVBCCHKR",70,0) .S TODAYDT=Y K Y,X "RTN","DVBCCHKR",71,0) .S SITE=$$SITE^DVBCUTL4 "RTN","DVBCCHKR",72,0) .D RPTHD^DVBCULAP W !!!!!?25,"Nothing found to report",!! "RTN","DVBCCHKR",73,0) .I (IOST?1"C-".E) D PAUSE^DVBCUTL4 "RTN","DVBCCHKR",74,0) .K TODAYDT,SITE "RTN","DVBCCHKR",75,0) I $D(^TMP("DVBA",$J)) D:(+$$RPTCHK=1) ^DVBCULAP "RTN","DVBCCHKR",76,0) ; "RTN","DVBCCHKR",77,0) EXIT D ^%ZISC "RTN","DVBCCHKR",78,0) W:'$D(ZTQUEUED) @FF,!!! "RTN","DVBCCHKR",79,0) I $D(ZTQUEUED)&($D(DVBCMAN)) D KILL^%ZTLOAD "RTN","DVBCCHKR",80,0) K %,%Y,DTA,DTB,DTOUT,DVBCDT,FF,HD,NAME,PG,I,ZTSAVE,POP,X,XI,Y,ZTDESC,ZTIO,ZTRTN,ZTSK,ITEMS,PRINT,DFN,DA,LN,DVBCMAN,DVBCQUIT,GETOUT,DVBCX,HDRPRT "RTN","DVBCCHKR",81,0) K ^TMP("DVBA",$J),^TMP($J),REQDA,STYLEIND,DVBAY,DIQ,DIR,DIRUT,DUOUT "RTN","DVBCCHKR",82,0) K DR,DIC "RTN","DVBCCHKR",83,0) Q "RTN","DVBCCHKR",84,0) ; "RTN","DVBCCHKR",85,0) HDR S PG=PG+1,HDRPRT="" W @IOF "RTN","DVBCCHKR",86,0) W !,DVBCDT,?(80-$L(HD)\2),HD,?69,"Page: ",PG,!,?(80-$L($$SITE^DVBCUTL4)\2),$$SITE^DVBCUTL4,!!,"Veteran name",?28,"Social Sec #",?50,"Missing items",! "RTN","DVBCCHKR",87,0) Q "RTN","DVBCCHKR",88,0) ; "RTN","DVBCCHKR",89,0) LINKCK ;** Patient DFN's w/ 2507's >3 days w/out links "RTN","DVBCCHKR",90,0) ;** Called - 2507 C&P INTEG RPT'=OFF "RTN","DVBCCHKR",91,0) ;** $D(DVBAFND) - 2507 >3 days old w/out links "RTN","DVBCCHKR",92,0) N DVBAX,DVBADAYS "RTN","DVBCCHKR",93,0) S:'$D(X) X="" "RTN","DVBCCHKR",94,0) S DVBAX=X ;**Save X (prob report var) "RTN","DVBCCHKR",95,0) I +$$STYLE^DVBCUTL8(REQDA)=1 DO "RTN","DVBCCHKR",96,0) .K X,X1,X2 "RTN","DVBCCHKR",97,0) .D NOW^%DTC "RTN","DVBCCHKR",98,0) .S X2=($P(^DVB(396.3,REQDA,0),U,5)\1),X1=X\1 "RTN","DVBCCHKR",99,0) .K X D ^%DTC "RTN","DVBCCHKR",100,0) .S DVBADAYS=X K X "RTN","DVBCCHKR",101,0) .S X=DVBAX ;**Reset X (prob var) "RTN","DVBCCHKR",102,0) .I +DVBADAYS>3 DO ;**2507 >3 days old, check links "RTN","DVBCCHKR",103,0) ..N APPTDA S APPTDA="" "RTN","DVBCCHKR",104,0) ..K DVBAFND "RTN","DVBCCHKR",105,0) ..I +$O(^DVB(396.95,"AR",REQDA,APPTDA))'>0 DO "RTN","DVBCCHKR",106,0) ...S:$$TRANCHK^DVBCUTA4(REQDA)=0 DVBAFND="" ;**2507 w/out links "RTN","DVBCCHKR",107,0) ..I $D(DVBAFND) DO ;**Unlinked 2507 >3 days old "RTN","DVBCCHKR",108,0) ...S:(+$$RPTCHK=1) ^TMP("DVBA",$J,NAME,DFN)="" ;**TMP("DVBA") - unlinked 2507's "RTN","DVBCCHKR",109,0) ...S X=X_"199^" "RTN","DVBCCHKR",110,0) K DVBAFND "RTN","DVBCCHKR",111,0) Q "RTN","DVBCCHKR",112,0) ; "RTN","DVBCCHKR",113,0) RPTCHK() ;**Check C&P Report Param field - 396.1 "RTN","DVBCCHKR",114,0) N PARAMDA,PARAMVAL S PARAMDA=0 "RTN","DVBCCHKR",115,0) S PARAMDA=$O(^DVB(396.1,PARAMDA)) "RTN","DVBCCHKR",116,0) S PARAMVAL=$P(^DVB(396.1,PARAMDA,0),U,19) "RTN","DVBCCHKR",117,0) Q PARAMVAL "RTN","DVBCCHKR",118,0) ; "RTN","DVBCCHKR",119,0) NAMELN W LN,!!,NAME,?28,$P(^DPT(DFN,0),U,9) "RTN","DVBCCHKR",120,0) Q "RTN","DVBCCHKR",121,0) ; "RTN","DVBCCHKR",122,0) SETSTYLE ; "RTN","DVBCCHKR",123,0) S PARAMDA=0 "RTN","DVBCCHKR",124,0) S PARAMDA=$O(^DVB(396.1,PARAMDA)) "RTN","DVBCCHKR",125,0) S STYLEIND=$P(^DVB(396.1,PARAMDA,0),U,15) "RTN","DVBCCHKR",126,0) Q "RTN","DVBCCNC1") 0^3^B14689531^B14407596 "RTN","DVBCCNC1",1,0) DVBCCNC1 ;ALB ISC/THM-CANCEL ENTIRE REQUEST ; 9/22/91 4:14 PM "RTN","DVBCCNC1",2,0) ;;2.7;AMIE;**194**;Apr 10, 1995;Build 5 "RTN","DVBCCNC1",3,0) ; "RTN","DVBCCNC1",4,0) ALL K NONE W ! S ALLCANC=1,DIC="^DVB(396.5,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,3)=1",DIC("A")="Enter REASON FOR CANCELLATION: " D ^DIC G:X=""!(X=U)!(+Y'>0) EXIT^DVBCCNCL S REAS=+Y "RTN","DVBCCNC1",5,0) ; "RTN","DVBCCNC1",6,0) BY W !,"Cancelled by (M)AS or (R)O? M// " "RTN","DVBCCNC1",7,0) R BY:DTIME "RTN","DVBCCNC1",8,0) G:'$T!(BY=U) EXIT^DVBCCNCL "RTN","DVBCCNC1",9,0) I BY=""!(BY="m") W:BY="" "M" S BY="M" ;echo selection "RTN","DVBCCNC1",10,0) S:BY="r" BY="R" "RTN","DVBCCNC1",11,0) I BY'?1"M"&(BY'?1"R") W !!,"Enter M to indicate cancellation by MAS or",!," R to indicate cancellation by the Regional Office.",!! G BY "RTN","DVBCCNC1",12,0) W $S(BY="M":"AS",BY="R":"O",1:"") ;finish echo of selection "RTN","DVBCCNC1",13,0) ; "RTN","DVBCCNC1",14,0) BY1 W *7,!!,"Cancelled by ",$S(BY="":"MAS",BY="M":"MAS",BY="R":"RO",1:"Unknown source")," Ok" S %=2 D YN^DICN G:$D(DTOUT)!(%<0) EXIT^DVBCCNCL "RTN","DVBCCNC1",15,0) I $D(%Y),%Y["?" W !!,"Enter Y to verify or N to reselect",! G BY1 "RTN","DVBCCNC1",16,0) I $D(%),%'=1 G BY "RTN","DVBCCNC1",17,0) S BY=$S(BY="R":"RX",BY="M":"X",1:"") "RTN","DVBCCNC1",18,0) W !! "RTN","DVBCCNC1",19,0) F JJZ=0:0 S JJZ=$O(^DVB(396.4,"C",DA(1),JJZ)) Q:JJZ="" S STAT=$P(^DVB(396.4,JJZ,0),U,4) I STAT="O" D ALL1 "RTN","DVBCCNC1",20,0) I '$D(CANC) S CANC("None - (Request only)")=BY_U_REAS ;used in case of request logging error (system) "RTN","DVBCCNC1",21,0) H 1 S DA=DA(1),(DIC,DIE)="^DVB(396.3,",DR="17////"_BY_";19///NOW;20////^S X=DUZ" D ^DIE,NOTIFY,BULL I $D(OUT) G EXIT^DVBCCNCL "RTN","DVBCCNC1",22,0) G LOOK^DVBCCNCL "RTN","DVBCCNC1",23,0) ; "RTN","DVBCCNC1",24,0) ALL1 S EXMPTR=$P(^DVB(396.4,JJZ,0),U,3),EXMNM=$S($D(^DVB(396.6,+EXMPTR,0)):$P(^(0),U,1),1:"Unknown exam"_" ("_+EXMPTR_")") K EXMPTR ;show deleted exam "RTN","DVBCCNC1",25,0) S DR=".04////"_BY_";52////"_REAS_";51////^S X=DUZ;50///NOW",DA=JJZ "RTN","DVBCCNC1",26,0) S (DIC,DIE)="^DVB(396.4," D ^DIE "RTN","DVBCCNC1",27,0) I '$D(Y) W:$X>50 ! W:$L(EXMNM)>25&($X>45) ! W EXMNM," cancelled, " S CANC(EXMNM)=BY_U_REAS "RTN","DVBCCNC1",28,0) I $D(Y) W *7,!,"Cancellation error on ",EXMNM," exam !" H 2 "RTN","DVBCCNC1",29,0) Q "RTN","DVBCCNC1",30,0) ; "RTN","DVBCCNC1",31,0) NOTIFY S X=$P(^DVB(396.3,DA,0),U,18) I X="RX"!(X="X") W !!,"Entire exam is now CANCELLED.",!! H 1 Q "RTN","DVBCCNC1",32,0) I X'="RX"&(X'="X") W *7,!!,"Cancellation error !",!! H 3 S OUT=1 "RTN","DVBCCNC1",33,0) Q "RTN","DVBCCNC1",34,0) ; "RTN","DVBCCNC1",35,0) BULL Q:'$D(CANC) S SEND=1,EXAM="" 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 SEND=0 Q "RTN","DVBCCNC1",36,0) I SEND=0 W *7,!!,"An error has occurred during cancellation - bulletin will not be sent!",!!,*7 H 3 Q "RTN","DVBCCNC1",37,0) K OWNDOM,XDOM,DOMAIN,DOMNUM "RTN","DVBCCNC1",38,0) I $D(ALLCANC) S OWNDOM=$P(^DVB(396.3,DA(1),0),U,22) I OWNDOM]"" S XDOM=$S($D(^DIC(4.2,OWNDOM,0)):^(0),1:"") S DOMAIN=$P(XDOM,U,1),DOMNUM=$S(+$P(XDOM,U,3)>0:+$P(XDOM,U,3),1:OWNDOM) "RTN","DVBCCNC1",39,0) I $D(ALLCANC),OWNDOM]"" I +DOMNUM>0 S XMY("G.DVBA C 2507 CANCELLATION@"_DOMAIN)=DOMNUM W !!,*7,"I am sending a copy of this cancellation to the",!,"cancellation mail group at "_DOMAIN,!,"since this was transferred in.",!! H 2 "RTN","DVBCCNC1",40,0) I SEND=1 S REQDA=DA(1) D ^DVBCBULL I $D(ALLCANC),OWNDOM]"",+DOMNUM>0 S REQDA=DA(1) D EN1^DVBCXFRE "RTN","DVBCCNC1",41,0) K ALLCANC,CANC,SEND,OWNDOM,DOMNUM "RTN","DVBCCNC1",42,0) Q "RTN","DVBCCNCL") 0^2^B29391810^B27121636 "RTN","DVBCCNCL",1,0) DVBCCNCL ;ALB/GTS - 557/THM-2507 CANCEL REQUESTS, EXAMS ; 9/23/91 9:25 AM "RTN","DVBCCNCL",2,0) ;;2.7;AMIE;**102,184,194**;Apr 10, 1995;Build 5 "RTN","DVBCCNCL",3,0) ; "RTN","DVBCCNCL",4,0) G EN "RTN","DVBCCNCL",5,0) LOOK1 S EXAM=$S($D(^DVB(396.6,$P(^DVB(396.4,JZ,0),U,3),0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCCNCL",6,0) S STAT=$P(^DVB(396.4,JZ,0),U,4) "RTN","DVBCCNCL",7,0) S $P(^TMP($J,EXAM),U,1)=STAT_U_JZ S:STAT="C" TCNCL=1 S:STAT="T" TCNCL=2 "RTN","DVBCCNCL",8,0) Q "RTN","DVBCCNCL",9,0) ; "RTN","DVBCCNCL",10,0) EN ; "RTN","DVBCCNCL",11,0) N DVBCARY,DVBCRDAT,DVBCSITE "RTN","DVBCCNCL",12,0) D HOME^%ZIS S FF=IOF,HD="2507 Exam Veteran Selection",HD2="2507 Test Cancellation" "RTN","DVBCCNCL",13,0) ; "RTN","DVBCCNCL",14,0) LOOK D KILL W @FF,!?(IOM-$L(HD)\2),HD,!?(IOM-$L(HD2)\2),HD2,!! S DIC("W")="D DICW^DVBCUTIL" S DIC="^DVB(396.3,",DIC(0)="AEQM",DIC("A")="Select VETERAN: " D ^DIC G:X=""!(X=U) EXIT I +Y<0 W *7," ???" G LOOK "RTN","DVBCCNCL",15,0) S DA(1)=+Y,DFN=$P(Y,U,2),STAT=$P(^DVB(396.3,DA(1),0),U,18) D STATCHK G:$D(NCN) LOOK S REQDT=$P(^DVB(396.3,DA(1),0),U,2) "RTN","DVBCCNCL",16,0) D GETS^DIQ(396.3,DA(1),"1;2","E","DVBCARY") "RTN","DVBCCNCL",17,0) S DVBCRDAT=DVBCARY(396.3,DA(1)_",",1,"E") "RTN","DVBCCNCL",18,0) S DVBCSITE=DVBCARY(396.3,DA(1)_",",2,"E") "RTN","DVBCCNCL",19,0) I '$D(^DPT(DFN,0)) W *7,!!,"Zeroth node for ^DPT record missing!",!! H 3 G LOOK "RTN","DVBCCNCL",20,0) S PNAM=$P(^DPT(DFN,0),U,1),SSN=$P(^(0),U,9),CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") K DICW "RTN","DVBCCNCL",21,0) S REQRO=$P(^DVB(396.3,DA(1),0),U,3),REQSTR=$P(^(0),U,4) ;used to screen bulletins "RTN","DVBCCNCL",22,0) K TCNCL F JZ=0:0 S JZ=$O(^DVB(396.4,"C",DA(1),JZ)) Q:JZ="" D LOOK1 "RTN","DVBCCNCL",23,0) ; "RTN","DVBCCNCL",24,0) ASK I $D(TCNCL) W *7,!!,"This request cannot be cancelled entirely because",!," one or more exams have ",$S(TCNCL=2:"been transferred.",1:"been completed.") "RTN","DVBCCNCL",25,0) I W !!,"However, you may cancel other individual exams.",!!,"Press RETURN " R ANS:60 G:'$T!(ANS="^") EXIT G DATA "RTN","DVBCCNCL",26,0) W !!,"Do you want to cancel the entire exam" S %=2 D YN^DICN G:$D(DTOUT)!(%<0) EXIT G:%=1 ^DVBCCNC1 "RTN","DVBCCNCL",27,0) I $D(%Y),%Y["?" W !!,"Enter Y to cancel the ENTIRE exam or N to cancel ONLY selected exams",!! G ASK "RTN","DVBCCNCL",28,0) ; "RTN","DVBCCNCL",29,0) DATA K EXMPTR,NCN "RTN","DVBCCNCL",30,0) D HDR^DVBCUTIL "RTN","DVBCCNCL",31,0) EXMSEL S REQDA=DA(1),Y=$$EXSRH^DVBCUTL4("Select EXAM TO CANCEL: ","I $D(^DVB(396.4,""ARQ""_REQDA,+Y))") ;*Exam lookup function call "RTN","DVBCCNCL",32,0) K DIC("S"),REQDA "RTN","DVBCCNCL",33,0) N DVBACR "RTN","DVBCCNCL",34,0) G:$D(DTOUT) EXIT I X=""!(X=U)&($D(CANC)) D BULL^DVBCCNC1 G LOOK "RTN","DVBCCNCL",35,0) I $D(X),X=""!(X=U)&('$D(CANC)) G LOOK "RTN","DVBCCNCL",36,0) I Y=-1 W *7," ??" G EXMSEL ;DVBA*2.7*102 "RTN","DVBCCNCL",37,0) I ($P(^DVB(396.4,+Y,0),U,4)["X")!($P(^DVB(396.4,+Y,0),U,4)="T") W *7," ??" G EXMSEL "RTN","DVBCCNCL",38,0) S EXMPTR=+Y,EXMNM=$P(^DVB(396.4,+Y,0),U,3) "RTN","DVBCCNCL",39,0) S EXMNM=$S($D(^DVB(396.6,EXMNM,0)):$P(^(0),U,1),1:"Unknown exam") "RTN","DVBCCNCL",40,0) S STAT=$P(^TMP($J,EXMNM),U,1) D STATCHK G:$D(NCN) DATA "RTN","DVBCCNCL",41,0) D CNCLCHK G:NOFND=0 DATA G:$D(OUT) EXIT "RTN","DVBCCNCL",42,0) ; "RTN","DVBCCNCL",43,0) ; ** If selected an exam, enter Cancellation Reason. "RTN","DVBCCNCL",44,0) S DVBCMSG=" for this "_EXMNM_" exam:",EXMCNC="" D CODE G:$D(OUT) EXIT "RTN","DVBCCNCL",45,0) ;RRA DVBA*2.7*194 filter out inactive cancelation reasons "RTN","DVBCCNCL",46,0) S DIC="^DVB(396.5,",DIC(0)="QEAZ",DIC("S")="I $P(^(0),U,3)=1" "RTN","DVBCCNCL",47,0) F D ^DIC Q:X'="" W " ??",!," Enter the response which best describes the reason for the cancellation." "RTN","DVBCCNCL",48,0) I +Y<0 G EXIT "RTN","DVBCCNCL",49,0) S DVBACR=+Y "RTN","DVBCCNCL",50,0) S DR="52////"_DVBACR_";.04////"_CCODE_";51////^S X=DUZ;50///NOW",DIE="^DVB(396.4," "RTN","DVBCCNCL",51,0) S DA=EXMPTR D ^DIE K DR,DIE G:($D(Y))!($D(DTOUT)) EXIT "RTN","DVBCCNCL",52,0) S STAT=$P(^DVB(396.4,DA,0),U,4),REASON=+$P(^DVB(396.4,DA,"CAN"),U,3) "RTN","DVBCCNCL",53,0) G:REASON=0 LOOK S $P(^TMP($J,EXMNM),U,1)=STAT "RTN","DVBCCNCL",54,0) S ^TMP("DVBA",$J,9999999-$P(^DVB(396.4,EXMPTR,"CAN"),U,1))=CCODE "RTN","DVBCCNCL",55,0) S CANC(EXMNM)=STAT_U_REASON D CNCLCHK I $D(OUT) G EXIT "RTN","DVBCCNCL",56,0) K %DT G DATA "RTN","DVBCCNCL",57,0) ; "RTN","DVBCCNCL",58,0) EXIT D KILL K CCODE,DVBCMSG,TCNCL,^TMP($J),EXMPTR,J G KILL^DVBCUTIL "RTN","DVBCCNCL",59,0) ; "RTN","DVBCCNCL",60,0) KILL K TCNCL,DIC,DA,D0,D1,DFN,X,Y,OLDEXAM,JDR,REQDT,DR,EXMNM,NCN,STAT,%,NOFND,CANC,^TMP($J),%Y,Z,JY,JZ,DA,DIC,DIE,ALLCANC "RTN","DVBCCNCL",61,0) K DVBCARY,DVBCRDAT,DVBCSITE "RTN","DVBCCNCL",62,0) Q "RTN","DVBCCNCL",63,0) ; "RTN","DVBCCNCL",64,0) CNCLCHK S NOFND=0,Z=$P(^DVB(396.3,DA(1),0),U,18) Q:Z="X"!(Z="RX") K Z S I="" F J=0:0 S I=$O(^TMP($J,I)) Q:I="" I $P(^TMP($J,I),U,1)'="X"&($P(^(I),U,1)'="RX") S NOFND=1 "RTN","DVBCCNCL",65,0) Q:NOFND=1 W *7,!!,"Since all exams have been cancelled",!,"the entire request will be CANCELLED.",!! H 3 "RTN","DVBCCNCL",66,0) S DVBCMSG=" for this request:" D CODE "RTN","DVBCCNCL",67,0) S DR="17////"_CCODE_";19///NOW;20////^S X=DUZ" "RTN","DVBCCNCL",68,0) S DA=DA(1),DIE="^DVB(396.3," D ^DIE S DA=DA(1) D NOTIFY^DVBCCNC1 "RTN","DVBCCNCL",69,0) Q "RTN","DVBCCNCL",70,0) ; "RTN","DVBCCNCL",71,0) STATCHK Q:STAT="P"!(STAT="N")!(STAT="NT")!(STAT="S")!(STAT="O") "RTN","DVBCCNCL",72,0) W !!,*7,"This exam or request has been ",$S(STAT="RX":"cancelled by the RO",STAT="X":"cancelled by MAS",STAT="T":"transcribed",STAT="R":"released",STAT="C":"completed",STAT="CT":"completed, transferred out",1:"given an incorrect status"),".",!! "RTN","DVBCCNCL",73,0) S NCN=1 H 2 Q "RTN","DVBCCNCL",74,0) ;NCN=no can do "RTN","DVBCCNCL",75,0) Q "RTN","DVBCCNCL",76,0) ; "RTN","DVBCCNCL",77,0) CODE S:'$D(DVBCMSG) DVBCMSG=":" W @IOF,!,"Please enter cancellation code"_DVBCMSG,! K OUT,% "RTN","DVBCCNCL",78,0) S DIR("A")="CANCELLED BY" "RTN","DVBCCNCL",79,0) S:'$D(EXMCNC) DIR(0)="SO^X:MAS CANCELLATION;RX:REGIONAL OFFICE CANCELLATION" "RTN","DVBCCNCL",80,0) S:$D(EXMCNC) DIR(0)="S^X:MAS CANCELLATION;RX:REGIONAL OFFICE CANCELLATION" "RTN","DVBCCNCL",81,0) D ^DIR S CCODE=Y "RTN","DVBCCNCL",82,0) I CCODE=U&('$D(EXMCNC)) W !!,*7,"NO '^' ALLOWED AT THIS PROMPT" D CONTMES^DVBCUTL4 G CODE "RTN","DVBCCNCL",83,0) I $D(DTOUT) D RQCODE^DVBCUTL2 S OUT=1 Q "RTN","DVBCCNCL",84,0) I (X=""&('$D(EXMCNC))) W !,*7,"This is a required response." D CONTMES^DVBCUTL4 G CODE "RTN","DVBCCNCL",85,0) CNCBY W !!,*7,"CANCELLED BY ",$S(CCODE="X":"MAS",CCODE="RX":"RO",1:"???"),", OK" S %=2 D YN^DICN I %=2 G CODE "RTN","DVBCCNCL",86,0) I %=-1&('$D(EXMCNC)&('$D(DTOUT))) W !!,*7,"NO '^' ALLOWED AT THIS PROMPT" D CONTMES^DVBCUTL4 G CNCBY "RTN","DVBCCNCL",87,0) K EXMCNC "RTN","DVBCCNCL",88,0) I $D(DTOUT) D BULL^DVBCCNC1 S OUT=1 Q "RTN","DVBCCNCL",89,0) Q "VER") 8.0^22.0 "BLD",10025,6) ^170 **END** **END**