| [613] | 1 | DVBCXFRS ;ALB/GTS-557/THM-STUFF C&P TRANSFER RESULTS ; 5/30/91 9:59 AM
|
|---|
| 2 | ;;2.7;AMIE;**10**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN1 S (CNT,CNTA)=0 K OUT,FINISH
|
|---|
| 5 | F DVBCI=0:0 X XMREC S:XMRG["$END" FINISH=1 Q:XMER<0!(XMRG["$END") S XLN=XMRG,SUB=$E(XLN,2,5),XLN=$E(XLN,7,245) K OUT D @SUB Q:$D(OUT)
|
|---|
| 6 | K DFN,REQDT,EXMNM
|
|---|
| 7 | I '$D(FINISH) D BULL6^DVBCXFRD G EXIT ;sent to sender at orig site
|
|---|
| 8 | ;check to see if complete, if so send bulletins
|
|---|
| 9 | S NFINAL=0
|
|---|
| 10 | F EXMDA=0:0 S EXMDA=$O(^DVB(396.4,"C",REQDA,EXMDA)) Q:EXMDA="" S STAT=$P($G(^DVB(396.4,EXMDA,0)),U,4) I STAT'="C"&(STAT'["X") S NFINAL=1
|
|---|
| 11 | S CURSTAT=$S(CURSTAT]""&(CURSTAT["X"):CURSTAT,1:"T")
|
|---|
| 12 | I '$D(ALLROPN),NFINAL=0 S (DIC,DIE)="^DVB(396.3,",DA=REQDA,DR="17///"_CURSTAT_$S(RQCANCDT:";19////"_RQCANCDT,1:"") D ^DIE
|
|---|
| 13 | I NFINAL=0 S DFN=$P(^DVB(396.3,REQDA,0),U,1),REQDT=$P(^(0),U,2),PNAM=$P(^DPT(DFN,0),U,1),SSN=$P(^(0),U,9)
|
|---|
| 14 | I NFINAL=0 S XMB="DVBA C 2507 EXAM READY",XMB(1)=PNAM,XMB(2)=SSN,Y=REQDT X ^DD("DD") S XREQDT=Y,XMB(3)=XREQDT D ^XMB K XMB,XREQDT
|
|---|
| 15 | EXIT D DELSER^DVBCUTL4
|
|---|
| 16 | K FINISH,ALLROPN,CURSTAT,RQCANCDT G KILL^DVBCUTIL
|
|---|
| 17 | ;
|
|---|
| 18 | USER S USER=$P(XLN,U,1),SITE=$P(XLN,U,2),SITE1=$P(XLN,U,3)
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | RQDA S REQDA=+XLN,DTTRNSC=$P(XLN,U,2),CURSTAT=$P(XLN,U,3),RQCANCDT=$P(XLN,U,4)
|
|---|
| 22 | I '$D(^DVB(396.3,REQDA,0)) D BULL4^DVBCXFRD K DIC,DIE,DA,REQDA S OUT=1
|
|---|
| 23 | S (DIC,DIE)="^DVB(396.3,",DR="11////"_DTTRNSC,DA=REQDA D ^DIE K DIC,DIE,DR
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | EXAM N DFN,REQDT,EXMNM S DFN=$P(^DVB(396.3,REQDA,0),U,1),REQDT=$P(^(0),U,2)
|
|---|
| 27 | S EXM=$P(XLN,U,1),WRKSHT=$P(XLN,U,2),EXSTAT=$P(XLN,U,3)
|
|---|
| 28 | S EXMNM=$P(^DVB(396.6,EXM,0),U,1),CNT=0
|
|---|
| 29 | S CANCREM=$P(XLN,U,4),CANCBY=$P(XLN,U,5),CANCDT=$P(XLN,U,6)
|
|---|
| 30 | S EXMDT=$P(XLN,U,7),EXPHYS=$P(XLN,U,8),FEXM=$P(XLN,U,9)
|
|---|
| 31 | S EXMPL=$P(XLN,U,10),DATRETN=$P(XLN,U,11)
|
|---|
| 32 | S DA=$O(^DVB(396.4,"APE",DFN,EXMNM,REQDT,0))
|
|---|
| 33 | I DA="" D BULL5^DVBCXFRD S OUT=1 Q
|
|---|
| 34 | S (DIC,DIE)="^DVB(396.4,"
|
|---|
| 35 | S DR=".05////"_WRKSHT_";.04////"_EXSTAT_";52////"_CANCREM_";51////"_CANCBY_";50////"_CANCDT_";.06////"_EXMDT_";.07////"_EXPHYS_";.08////"_FEXM_";.09////"_EXMPL_";63////"_DATRETN
|
|---|
| 36 | D ^DIE
|
|---|
| 37 | I $D(ALLROPN) K DR S DR="52///@;51///@;50///@" D ^DIE ;can't stuff nulls
|
|---|
| 38 | S NCN=0 F ZH=0:0 S ZH=$O(^DVB(396.4,"C",REQDA,ZH)) Q:ZH="" I $P(^DVB(396.4,ZH,0),U,4)="T" S NCN=1
|
|---|
| 39 | I NCN=0 S (DIC,DIE)="^DVB(396.3,",DA=REQDA,DR="31///@;34////"_DT D ^DIE
|
|---|
| 40 | K NCN,ZZ Q
|
|---|
| 41 | ;
|
|---|
| 42 | ROPN S ALLROPN=1,(DIC,DIE)="^DVB(396.3,",DA=REQDA
|
|---|
| 43 | S DR="11///@;31////y;34///@;17////P"
|
|---|
| 44 | D ^DIE ;transfers cancelled in error
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | RSLT S DFN=$P(^DVB(396.3,REQDA,0),U,1)
|
|---|
| 48 | S DA=$O(^DVB(396.4,"APS",DFN,EXM,"C",0))
|
|---|
| 49 | I '$D(^DVB(396.4,DA,"RES",0)) S ^(0)="^^0^0^"_DT_"^^^^"
|
|---|
| 50 | I DA="" D BULL5^DVBCXFRD S OUT=1 Q
|
|---|
| 51 | S CNT=CNT+1,^DVB(396.4,DA,"RES",CNT,0)=XLN
|
|---|
| 52 | F X=3,4 S $P(^DVB(396.4,DA,"RES",0),U,X)=CNT
|
|---|
| 53 | Q
|
|---|
