| 1 | DVBCXFRB ;ALB/GTS-557/THM-LOAD TRANSFER MAIL MESSAGE ; 4/29/91 8:09 AM
|
---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
---|
| 3 | ;
|
---|
| 4 | EN ;file 2
|
---|
| 5 | K ^TMP("DVBCXFR",$J),L S X=^DVB(396.3,REQDA,0),DFN=$P(X,U,1)
|
---|
| 6 | S X=^DPT(DFN,0),PNAM=$P(X,U,1),DOB=$P(X,U,3),SEX=$P(X,U,2),SSN=$P(X,U,9)
|
---|
| 7 | S X=$S($D(^DPT(DFN,.11)):^(.11),1:""),ADR1=$P(X,U,1),ADR2=$P(X,U,2),ADR3=$P(X,U,3),CITY=$P(X,U,4),STATE=$P(X,U,5),ZIP=$P(X,U,6),CNTY=$P(X,U,7),ZIP4=$P(X,U,12)
|
---|
| 8 | S CNTY=$S($D(^DIC(5,+STATE,1,+CNTY,0)):$P(^(0),U,1),1:""),STATE=$S($D(^DIC(5,+STATE,0)):$P(^(0),U,1),1:"")
|
---|
| 9 | S X=$S($D(^DPT(DFN,.13)):^(.13),1:"") S HOMPHON=$P(X,U,1),BUSPHON=$P(X,U,2)
|
---|
| 10 | S X=$S($D(^DPT(DFN,.3)):^(.3),1:""),SRVCON=$P(X,U,1),SRVPCT=$P(X,U,2)
|
---|
| 11 | S X=$S($D(^DPT(DFN,.31)):^(.31),1:""),CNUM=$P(X,U,3)
|
---|
| 12 | S CFLOC=$$STATION^DVBAUTL1(DFN)
|
---|
| 13 | S:CFLOC=-1 CFLOC=""
|
---|
| 14 | S X=$S($D(^DPT(DFN,.32)):^(.32),1:""),PDSRV=$P(X,U,3),SRVEDT=$P(X,U,6),SRVSDT=$P(X,U,7),PDSRV=$S($D(^DIC(21,+PDSRV,0)):$P(^(0),U,3),1:"")
|
---|
| 15 | S X=$S($D(^DPT(DFN,.36)):^(.36),1:""),ELIGCOD=$P(X,U,1),ELIGCOD=$S($D(^DIC(8,+ELIGCOD,0)):$P(^(0),U,9),1:"")
|
---|
| 16 | S X=$S($D(^DPT(DFN,.361)):^(.361),1:""),ELIGST=$P(X,U,1),ELIGSDT=$P(X,U,2)
|
---|
| 17 | S X=$S($D(^DPT(DFN,.52)):^(.52),1:""),POWSTAT=$P(X,U,5)
|
---|
| 18 | S X=$S($D(^DPT(DFN,"VET")):^("VET"),1:""),VETST=$P(X,U,1)
|
---|
| 19 | S X=$S($D(^DPT(DFN,"TYPE")):^("TYPE"),1:"") S TYPE=$S(X]"":$P(^DG(391,X,0),U,1),1:"")
|
---|
| 20 | S LINE(1)="$DEM0 "_PNAM_U_DOB_U_SEX_U_SSN
|
---|
| 21 | S LINE(2)="$DEM1 "_ADR1_U_ADR2_U_ADR3_U_CITY_U_STATE_U_CNTY_U_ZIP_U_HOMPHON_U_BUSPHON_U_ZIP4
|
---|
| 22 | S LINE(3)="$ELIG "_SRVCON_U_SRVPCT_U_CFLOC_U_CNUM_U_PDSRV_U_SRVEDT_U_SRVSDT_U_ELIGCOD_U_ELIGST_U_ELIGSDT_U_POWSTAT_U_VETST_U_TYPE
|
---|
| 23 | ;
|
---|
| 24 | ;file 396.3
|
---|
| 25 | EN1 S X=^DVB(396.3,REQDA,0),RO=$P(X,U,3),RONAM=$P($G(^DIC(4,+RO,99)),U,1),REQDT=$P(X,U,2),FEXM=$P(X,U,9),PRIO=$P(X,U,10),OTHDIS=$P(X,U,11),LREXMDT=$P(X,U,20)
|
---|
| 26 | S X=$S($D(^DVB(396.3,REQDA,1)):^(1),1:""),CFREQ=$P(X,U,2),OTHDOC=$P(X,U,3),LREXMDT=$P(X,U,7),OTHDIS1=$P(X,U,9),OTHDIS2=$P(X,U,10)
|
---|
| 27 | S LINE(4)="$REQ0 "_REQDA_U_RO_U_PRIO_U_CFLOC_U_LREXMDT_U_CFREQ_U_LREXMDT_U_RONAM
|
---|
| 28 | S LINE(5)="$ODIS "_OTHDIS_U_OTHDIS1_U_OTHDIS2
|
---|
| 29 | S EXAMS="$EXAM "_EXAMS,LINE(6)=EXAMS
|
---|
| 30 | ;**NOTE: RONAM is now RO NUMBER
|
---|
| 31 | LOAD S L=1,^TMP("DVBCXFR",$J,L,0)="$TRANSFER IN",L=L+1
|
---|
| 32 | F X=1:1 Q:'$D(LINE(X)) S ^TMP("DVBCXFR",$J,L,0)=LINE(X),L=L+1
|
---|
| 33 | F JI=0:0 S JI=$O(^DVB(396.3,REQDA,2,JI)) Q:JI="" S ^TMP("DVBCXFR",$J,L,0)="$REMK "_^DVB(396.3,REQDA,2,JI,0),L=L+1
|
---|
| 34 | S SITE=$P(^XMB(1,1,0),U,1),SITE1=$P(^DIC(4.2,SITE,0),U,1)
|
---|
| 35 | S USERNM=$P(^VA(200,DUZ,0),U,1),^TMP("DVBCXFR",$J,L,0)="$USER "_USERNM_U_SITE_U_SITE1,L=L+1
|
---|
| 36 | S ^TMP("DVBCXFR",$J,L,0)="$END "
|
---|
| 37 | N XMNODE
|
---|
| 38 | S XMNODE=0
|
---|
| 39 | F X=(L+1):1:(L+XMCNT) DO
|
---|
| 40 | .S XMNODE=XMNODE+1
|
---|
| 41 | .S ^TMP("DVBCXFR",$J,X,0)=XMVAR(XMNODE)
|
---|
| 42 | S ^TMP("DVBCXFR",$J,X+1,0)="$END1 "
|
---|
| 43 | ;
|
---|
| 44 | SEND K XMZ
|
---|
| 45 | ;S XMY("POSTMASTER@"_DOMNAM)=DOMNUM
|
---|
| 46 | S XMY(DUZ)="",XMY("S.DVBA C PROCESS MAIL MESSAGE@"_DOMNAM)=DOMNUM,XMSUB="Transfer of C&P Exams",XMTEXT="^TMP(""DVBCXFR"",$J,",XMDUZ=DUZ D ^XMD
|
---|
| 47 | I $D(XMZ) W !!,"Transmitted as message # "_XMZ_" from this site to "_DOMNAM,! H 3
|
---|
| 48 | I '$D(XMZ) W !!,*7,"Message transmission error!",!,"Request WILL NOT be transferred!",!!,"Press RETURN " R ANS:DTIME S OUT=1 G KILL^DVBCUTIL
|
---|
| 49 | ;if all ok, update main, sub-file
|
---|
| 50 | F III=0:0 S III=$O(XEXAMS(III)) Q:III="" S DIE="^DVB(396.4,",DA=III,DR=".04///T;62///"_DOMNAM_";60////"_DT_";61///"_USERNM D ^DIE
|
---|
| 51 | K DIE,DA,DR S DIE="^DVB(396.3,",DA=REQDA,DR="31///y;32///N"
|
---|
| 52 | D ^DIE ;set transfer items
|
---|
| 53 | K LINE,DOMNUM,DOMNUM1,^TMP("DVBCXFR",$J),XMDUZ,III,L,JI,JY,XMY,XMZ,XMSUB,XMTEXT,XMDUZ,DIE,DA,DR,TYPE
|
---|
| 54 | G KILL^DVBCUTIL
|
---|