source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCADEX.m@ 1474

Last change on this file since 1474 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1DVBCADEX ;ALB/GTS-557/THM-ADD C&P EXAMS TO REQUESTS, PART 1 ; 6/28/91 9:32 AM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4SETUP D HOME^%ZIS S FF=IOF,HD="Add a C & P Exam for",HD1="Veteran Selection",HD2="Exam selection",HD3="2507 Exam Addition"
5 ;
6EN K DVBCLCKD D KILL W @FF,!?(IOM-$L(HD3)\2),HD3,!!?(IOM-$L(HD1)\2),HD1,!!!
7 S DIC(0)="AEQM",DIC="^DVB(396.3,",DIC("A")="Select VETERAN NAME: "
8 S DIC("W")="D DICW^DVBCUTIL"
9 S:$D(DVBAROUS) DIC("S")="I $P(^(0),U,10)'=""E""" ;**DVBAROUS set by menu
10 D ^DIC G:X=""!(X=U) EXIT
11 S:+Y>0 EXCNT=0,(DA,REQDA)=+Y,DFN=$P(Y,U,2) I +Y<0 W " ???",*7 H 1 G EN
12 S X=^DVB(396.3,REQDA,0),OWNDOM=$P(X,U,22)
13 I OWNDOM]"" W *7,!!,"This request is a TRANSFER IN and exams cannot be added.",!! H 3 G EN
14 S STAT=$P(X,U,18) K NCN
15 F DTB="X","RX","T","C","R","CT","NT" I STAT=DTB S NCN=1 Q
16 I $D(NCN) W !!,*7,"This request has been ",$S(STAT["X":"cancelled",STAT="T":"transcribed",STAT["C":"completed",STAT="R":"released",STAT="NT":"transferred in",1:"given an incorrect status"),".",!! H 3 G EN
17 S DTA=^DPT(DFN,0),PNAM=$P(DTA,U,1),SSN=$P(DTA,U,9),CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") S:CNUM="" CNUM="Unknown" D HDR,^DVBCEEXM W !!,"Press RETURN " R ANS:DTIME G:'$T EXIT
18 D ^DVBCADE2,KILL G:$D(OUT)!($D(DVBCLCKD)) EXIT
19 G EN
20 ;
21EXIT K DVBCLCKD G KILL^DVBCUTIL
22 ;
23HDR W @FF,?(IOM-$L(HD)\2),HD,!!,"Veteran name: ",$P(PNAM,",",2,99)," ",$P(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
24 F LINE=1:1:IOM W "="
25 W ! Q
26 ;
27KILL K CNUM,DFN,DIK,DR,DTA,DXCOD,DXNUM,EDIT,EX,EXMNM,FMT,PNAM,SSN,PCT,SC,REQDA,CTIM,VX,JY,JJ,X,%,^TMP($J),Y,DA,DIC,DIE,ANS,%Y,%,DTOUT,DUOUT,TEMP,DVBCCONT
28 K DVBAINDA
29 Q
Note: See TracBrowser for help on using the repository browser.