APCLSMUN ; IHS/CMI/LAB - NIGHTLY MY SYNDROMIC SURV EXPORT
;;3.0;IHS PCC REPORTS;**22,23,24,25,26,27,28,29,30**;FEB 05, 1997;Build 27
;
;
START ;
;MUS SYNDROMIC SURV EXPORT
;runs nightly and should be scheduled at 12:05am
;gathers all ER and URGENT CARE visits that were modified since the last export
;1st run goes back 24 hours
;
;
D EN^XBVK("APCL")
S APCLSITE=$P($G(^AUTTSITE(1,0)),U,1)
I DUZ(2)'=APCLSITE Q ;MUST BE SCHEDULED AS MAIN SITE
S APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
S APCL1ST=$P($G(^APCLILIC(1,0)),U,6)
S APCLLAST="",APCLEXTY="R"
;FIND LAST LOG ENTRY
S X=0 F S X=$O(^APCLMUSS(X)) Q:X'=+X I $P(^APCLMUSS(X,0),U,7)="R" S APCLLAST=X
I 'APCLLAST D I 1
.S APCLBD=$$FMADD^XLFDT(DT,-1)
.S APCLED=$$FMADD^XLFDT(DT,-1)
E D
.S APCLL=$P(^APCLMUSS(APCLLAST,0),U,4) ;LAST END
.I APCL1ST S APCLBD=$$FMADD^XLFDT(APCLL,1)
.I 'APCL1ST S APCLBD=$$FMADD^XLFDT(APCLL,1)
.S APCLED=$$FMADD^XLFDT(DT,-1) ;
PROC ;EP - called from xbdbque
K ^XTMP("APCMUSS",$J)
;CREATE LOG ENTRY
S X=$$NOW^XLFDT(),DIC(0)="L",DIC("DR")=".02////"_APCLSITE_";.03////"_APCLBD_";.04////"_APCLED_";.07///"_APCLEXTY,DIC="^APCLMUSS(" K DO,D0 D FILE^DICN K DA,DIC
I Y=-1 Q
S APCLLOG=+Y
;
S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
F S APCLVD=$O(^AUPNVSIT("ADLM",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("ADLM",APCLVD,APCLV)) Q:APCLV'=+APCLV D
..Q:'$D(^AUPNVSIT(APCLV,0))
..Q:$P(^AUPNVSIT(APCLV,0),U,11)
..S APCLRS=$S($D(^APCLMUSS("C",APCLV)):"M",1:"A")
..D PROC1
;NOW GO BACK THROUGH ADLM AND FIND ANY H WITH AN ER
S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
F S APCLVD=$O(^AUPNVSIT("ADLM",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("ADLM",APCLVD,APCLV)) Q:APCLV'=+APCLV D
..Q:'$D(^AUPNVSIT(APCLV,0))
..Q:$P(^AUPNVSIT(APCLV,0),U,11)
..Q:$P(^AUPNVSIT(APCLV,0),U,7)'="H"
..S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
..Q:DFN=""
..Q:'$D(^DPT(DFN,0))
..Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"
..Q:$$DEMO^APCLUTL(DFN,"E")
..S APCLERV=$$ERV(APCLV) I 'APCLERV Q ;quit if no ER/UC within 2 days of the H admission date
..S APCLRS=$S($D(^APCLMUSS("C",APCLERV)):"M",1:"A")
..S ^XTMP("APCLMUSS",$J,APCLERV)=APCLRS_U_APCLV
..;I DUZ=2881 W !!,APCLERV," H: ",APCLV
;
;NOW GO THROUGH AVDEL XREF FOR DELETES SKIP IF THIS IS A FULL EXPORT
S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
F S APCLVD=$O(^AUPNVSIT("AVDEL",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED) D
.;W:'$D(ZTQUEUED) ".",$$FMTE^XLFDT(APCLSD)
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("AVDEL",APCLVD,APCLV)) Q:APCLV'=+APCLV D
..I '$D(^APCLMUSS("C",APCLV)) Q ;never exported so no need to send delete
..S APCLRS="D"
..D PROC1
D GENHL7
;UPDATE/REINDEX LOG
S DA=APCLLOG,DIK="^APCLMUSS(" D IXALL^DIK
S DA=APCLLOG,DIE="^APCLMUSS(",DR=".05///"_APCLVCNT_";.06///"_APCLFILE D ^DIE K DA,DIE
D PURGE
D EXIT
Q
ERV(H) ;is there an ER/UC Ambulatory visit within 2 days
NEW T,BD,ADMD,D,V,P,APCLVL,X,G
;T IS # of minutes in 2 days
S G=""
S P=$P(^AUPNVSIT(H,0),U,5) ;PATIENT
S ADMD=$$VDTM^APCLV(H) ;visit date/time in fileman format
S BD=$$FMADD^XLFDT($P(ADMD,"."),-2)
K APCLVL
D ALLV^APCLAPIU(P,$P(BD,"."),$P(ADMD,"."),"APCLVL")
I '$O(APCLVL(0)) Q ""
S X=0 F S X=$O(APCLVL(X)) Q:X'=+X D
.S V=$P(APCLVL(X),U,5)
.Q:$P(^AUPNVSIT(V,0),U,7)'="A"
.S C=$$CLINIC^APCLV(V,"C")
.I C'=30,C'=80 Q
.;Q:$$VDTM^APCLV(V)<(BD
.Q:$$VDTM^APCLV(V)>ADMD
.S G=V
Q G
PROC1 ;
Q:'$D(^AUPNVSIT(APCLV,0))
S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
Q:DFN=""
Q:'$D(^DPT(DFN,0))
Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"
Q:$$DEMO^APCLUTL(DFN,"E")
I $P(^AUPNVSIT(APCLV,0),U,7)'="A",APCLRS="A" Q ;ONLY AMBULATORY
I $P(^AUPNVSIT(APCLV,0),U,7)'="A",APCLRS="M" S APCLRS="D" ;WENT BEFORE AND NOW DOESN'T MEET CRITERIA SO DELETE IT
S APCLCLIN=$$CLINIC^APCLV(APCLV,"C")
I APCLRS="A",APCLCLIN'=30,APCLCLIN'=80 Q ;ONLY ER AND URGENT CARE
I APCLRS="M",APCLCLIN'=30,APCLCLIN'=80 S APCLRS="D" ;WENT BEFORE AND CLINIC HAS BEEN CHANGED SO SEND DELETE
S ^XTMP("APCLMUSS",$J,APCLV)=APCLRS
Q
;
GENHL7 ;
;LOOP THROUGH ^XTMP("APCLMUSS",$J,visitien)
;IF YOU EXPORT THE VISIT SET A VISIT COUNTER APCLVCNT=APCLVCNT+1
;S APCLFILE=filenmame used for export
;IF YOU EXPORT THE VISIT SET THE LOG 11 MULTIPLE D LOG^APCLSMUN(APCLLOG,VISITIEN,APCLRS)
N APCLDA,APCLREC,APCLPAT,APCLSEVN
N IVDT,EVDT,HVST
S APCLVCNT=0,APCLFILE=""
Q:'$D(^XTMP("APCLMUSS",$J))
D HL7^APCLSMU2
;DO THE HL7 MSG GENERATION HERE
Q
LOG(LOG,VISIT,STAT) ;EP - SET VISIT EXPORT MULTIPLE OF LOG
I '$G(LOG) Q
I '$D(^APCLMUSS(LOG,0)) Q
S:'$D(^APCLMUSS(LOG,11,0)) ^APCLMUSS(LOG,11,0)="^9001003.421101PA"
S ^APCLMUSS(LOG,11,VISIT,0)=VISIT_"^"_STAT
Q
DATE(D) ;EP
Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)
;
JDATE(D) ;EP - get date
I $G(D)="" Q ""
NEW A
S A=$$FMTE^XLFDT(D)
Q $E(D,6,7)_$$UP^XLFSTR($P(A," ",1))_(1700+$E(D,1,3))
;
UID(APCLA) ;Given DFN return unique patient record id.
I '$G(APCLA) Q ""
I '$D(^AUPNPAT(APCLA)) Q ""
;
Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(APCLA))_APCLA
;
EXIT ;clean up and exit
D EN^XBVK("APCL")
D ^XBFMK
K ^XTMP("APCLMUSS",$J)
Q
PURGE ;
W:'$D(ZTQUEUED) !!,"Now cleaning up host files older than 7 DAYS"
K APCLFILE,APCLDIR
S APCLDIR=$P($G(^AUTTSITE(1,1)),"^",2)
I APCLDIR="" S APCLDIR=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
I APCLDIR="" Q
S APCLASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)
S APCLDT=$$FMADD^XLFDT(DT,-31)
S APCLDT=$$DATE^APCLSILI(APCLDT)
S APCLFLST=$$LIST^%ZISH(APCLDIR,"MU2_"_APCLASU_"*",.APCLFILE)
Q:'$O(APCLFILE(""))
S APCLX=0 F S APCLX=$O(APCLFILE(APCLX)) Q:APCLX'=+APCLX D
.S D=$P($P(APCLFILE(APCLX),"."),"_",3)
.I D<APCLDT S N=APCLFILE(APCLX) S APCLM=$$DEL^%ZISH(APCLDIR,N)
Q
;
DATEXP ;-- ask the date range
D EN^XBVK("APCL")
S APCLSITE=$P($G(^AUTTSITE(1,0)),U,1)
I DUZ(2)'=APCLSITE Q ;MUST BE SCHEDULED AS MAIN SITE
S APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
S %DT="AE",%DT("A")="Begin Date: "
D ^%DT
I Y<0 D EXIT Q
S APCLBD=+Y
S %DT="AE",%DT("A")="End Date: "
D ^%DT
I Y<0 D EXIT Q
S APCLED=+Y
S APCLEXTY="D"
G PROC
Q
;
APCLSMUN ; IHS/CMI/LAB - NIGHTLY MY SYNDROMIC SURV EXPORT
+1 ;;3.0;IHS PCC REPORTS;**22,23,24,25,26,27,28,29,30**;FEB 05, 1997;Build 27
+2 ;
+3 ;
START ;
+1 ;MUS SYNDROMIC SURV EXPORT
+2 ;runs nightly and should be scheduled at 12:05am
+3 ;gathers all ER and URGENT CARE visits that were modified since the last export
+4 ;1st run goes back 24 hours
+5 ;
+6 ;
+7 DO EN^XBVK("APCL")
+8 SET APCLSITE=$PIECE($GET(^AUTTSITE(1,0)),U,1)
+9 ;MUST BE SCHEDULED AS MAIN SITE
IF DUZ(2)'=APCLSITE
QUIT
+10 SET APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
+11 SET APCL1ST=$PIECE($GET(^APCLILIC(1,0)),U,6)
+12 SET APCLLAST=""
SET APCLEXTY="R"
+13 ;FIND LAST LOG ENTRY
+14 SET X=0
FOR
SET X=$ORDER(^APCLMUSS(X))
IF X'=+X
QUIT
IF $PIECE(^APCLMUSS(X,0),U,7)="R"
SET APCLLAST=X
+15 IF 'APCLLAST
Begin DoDot:1
+16 SET APCLBD=$$FMADD^XLFDT(DT,-1)
+17 SET APCLED=$$FMADD^XLFDT(DT,-1)
End DoDot:1
IF 1
+18 IF '$TEST
Begin DoDot:1
+19 ;LAST END
SET APCLL=$PIECE(^APCLMUSS(APCLLAST,0),U,4)
+20 IF APCL1ST
SET APCLBD=$$FMADD^XLFDT(APCLL,1)
+21 IF 'APCL1ST
SET APCLBD=$$FMADD^XLFDT(APCLL,1)
+22 ;
SET APCLED=$$FMADD^XLFDT(DT,-1)
End DoDot:1
PROC ;EP - called from xbdbque
+1 KILL ^XTMP("APCMUSS",$JOB)
+2 ;CREATE LOG ENTRY
+3 SET X=$$NOW^XLFDT()
SET DIC(0)="L"
SET DIC("DR")=".02////"_APCLSITE_";.03////"_APCLBD_";.04////"_APCLED_";.07///"_APCLEXTY
SET DIC="^APCLMUSS("
KILL DO,D0
DO FILE^DICN
KILL DA,DIC
+4 IF Y=-1
QUIT
+5 SET APCLLOG=+Y
+6 ;
+7 SET APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+8 FOR
SET APCLVD=$ORDER(^AUPNVSIT("ADLM",APCLVD))
IF APCLVD'=+APCLVD!($PIECE(APCLVD,".")>APCLED)
QUIT
Begin DoDot:1
+9 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("ADLM",APCLVD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+10 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+11 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+12 SET APCLRS=$SELECT($DATA(^APCLMUSS("C",APCLV)):"M",1:"A")
+13 DO PROC1
End DoDot:2
End DoDot:1
+14 ;NOW GO BACK THROUGH ADLM AND FIND ANY H WITH AN ER
+15 SET APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+16 FOR
SET APCLVD=$ORDER(^AUPNVSIT("ADLM",APCLVD))
IF APCLVD'=+APCLVD!($PIECE(APCLVD,".")>APCLED)
QUIT
Begin DoDot:1
+17 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("ADLM",APCLVD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+18 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+19 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+20 IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"
QUIT
+21 SET DFN=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+22 IF DFN=""
QUIT
+23 IF '$DATA(^DPT(DFN,0))
QUIT
+24 IF $PIECE(^DPT(DFN,0),U)["DEMO,PATIENT"
QUIT
+25 IF $$DEMO^APCLUTL(DFN,"E")
QUIT
+26 ;quit if no ER/UC within 2 days of the H admission date
SET APCLERV=$$ERV(APCLV)
IF 'APCLERV
QUIT
+27 SET APCLRS=$SELECT($DATA(^APCLMUSS("C",APCLERV)):"M",1:"A")
+28 SET ^XTMP("APCLMUSS",$JOB,APCLERV)=APCLRS_U_APCLV
+29 ;I DUZ=2881 W !!,APCLERV," H: ",APCLV
End DoDot:2
End DoDot:1
+30 ;
+31 ;NOW GO THROUGH AVDEL XREF FOR DELETES SKIP IF THIS IS A FULL EXPORT
+32 SET APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+33 FOR
SET APCLVD=$ORDER(^AUPNVSIT("AVDEL",APCLVD))
IF APCLVD'=+APCLVD!($PIECE(APCLVD,".")>APCLED)
QUIT
Begin DoDot:1
+34 ;W:'$D(ZTQUEUED) ".",$$FMTE^XLFDT(APCLSD)
+35 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("AVDEL",APCLVD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+36 ;never exported so no need to send delete
IF '$DATA(^APCLMUSS("C",APCLV))
QUIT
+37 SET APCLRS="D"
+38 DO PROC1
End DoDot:2
End DoDot:1
+39 DO GENHL7
+40 ;UPDATE/REINDEX LOG
+41 SET DA=APCLLOG
SET DIK="^APCLMUSS("
DO IXALL^DIK
+42 SET DA=APCLLOG
SET DIE="^APCLMUSS("
SET DR=".05///"_APCLVCNT_";.06///"_APCLFILE
DO ^DIE
KILL DA,DIE
+43 DO PURGE
+44 DO EXIT
+45 QUIT
ERV(H) ;is there an ER/UC Ambulatory visit within 2 days
+1 NEW T,BD,ADMD,D,V,P,APCLVL,X,G
+2 ;T IS # of minutes in 2 days
+3 SET G=""
+4 ;PATIENT
SET P=$PIECE(^AUPNVSIT(H,0),U,5)
+5 ;visit date/time in fileman format
SET ADMD=$$VDTM^APCLV(H)
+6 SET BD=$$FMADD^XLFDT($PIECE(ADMD,"."),-2)
+7 KILL APCLVL
+8 DO ALLV^APCLAPIU(P,$PIECE(BD,"."),$PIECE(ADMD,"."),"APCLVL")
+9 IF '$ORDER(APCLVL(0))
QUIT ""
+10 SET X=0
FOR
SET X=$ORDER(APCLVL(X))
IF X'=+X
QUIT
Begin DoDot:1
+11 SET V=$PIECE(APCLVL(X),U,5)
+12 IF $PIECE(^AUPNVSIT(V,0),U,7)'="A"
QUIT
+13 SET C=$$CLINIC^APCLV(V,"C")
+14 IF C'=30
IF C'=80
QUIT
+15 ;Q:$$VDTM^APCLV(V)<(BD
+16 IF $$VDTM^APCLV(V)>ADMD
QUIT
+17 SET G=V
End DoDot:1
+18 QUIT G
PROC1 ;
+1 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+2 SET DFN=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+3 IF DFN=""
QUIT
+4 IF '$DATA(^DPT(DFN,0))
QUIT
+5 IF $PIECE(^DPT(DFN,0),U)["DEMO,PATIENT"
QUIT
+6 IF $$DEMO^APCLUTL(DFN,"E")
QUIT
+7 ;ONLY AMBULATORY
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="A"
IF APCLRS="A"
QUIT
+8 ;WENT BEFORE AND NOW DOESN'T MEET CRITERIA SO DELETE IT
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="A"
IF APCLRS="M"
SET APCLRS="D"
+9 SET APCLCLIN=$$CLINIC^APCLV(APCLV,"C")
+10 ;ONLY ER AND URGENT CARE
IF APCLRS="A"
IF APCLCLIN'=30
IF APCLCLIN'=80
QUIT
+11 ;WENT BEFORE AND CLINIC HAS BEEN CHANGED SO SEND DELETE
IF APCLRS="M"
IF APCLCLIN'=30
IF APCLCLIN'=80
SET APCLRS="D"
+12 SET ^XTMP("APCLMUSS",$JOB,APCLV)=APCLRS
+13 QUIT
+14 ;
GENHL7 ;
+1 ;LOOP THROUGH ^XTMP("APCLMUSS",$J,visitien)
+2 ;IF YOU EXPORT THE VISIT SET A VISIT COUNTER APCLVCNT=APCLVCNT+1
+3 ;S APCLFILE=filenmame used for export
+4 ;IF YOU EXPORT THE VISIT SET THE LOG 11 MULTIPLE D LOG^APCLSMUN(APCLLOG,VISITIEN,APCLRS)
+5 NEW APCLDA,APCLREC,APCLPAT,APCLSEVN
+6 NEW IVDT,EVDT,HVST
+7 SET APCLVCNT=0
SET APCLFILE=""
+8 IF '$DATA(^XTMP("APCLMUSS",$JOB))
QUIT
+9 DO HL7^APCLSMU2
+10 ;DO THE HL7 MSG GENERATION HERE
+11 QUIT
LOG(LOG,VISIT,STAT) ;EP - SET VISIT EXPORT MULTIPLE OF LOG
+1 IF '$GET(LOG)
QUIT
+2 IF '$DATA(^APCLMUSS(LOG,0))
QUIT
+3 IF '$DATA(^APCLMUSS(LOG,11,0))
SET ^APCLMUSS(LOG,11,0)="^9001003.421101PA"
+4 SET ^APCLMUSS(LOG,11,VISIT,0)=VISIT_"^"_STAT
+5 QUIT
DATE(D) ;EP
+1 QUIT (1700+$EXTRACT(D,1,3))_$EXTRACT(D,4,5)_$EXTRACT(D,6,7)
+2 ;
JDATE(D) ;EP - get date
+1 IF $GET(D)=""
QUIT ""
+2 NEW A
+3 SET A=$$FMTE^XLFDT(D)
+4 QUIT $EXTRACT(D,6,7)_$$UP^XLFSTR($PIECE(A," ",1))_(1700+$EXTRACT(D,1,3))
+5 ;
UID(APCLA) ;Given DFN return unique patient record id.
+1 IF '$GET(APCLA)
QUIT ""
+2 IF '$DATA(^AUPNPAT(APCLA))
QUIT ""
+3 ;
+4 QUIT $$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)_$EXTRACT("0000000000",1,10-$LENGTH(APCLA))_APCLA
+5 ;
EXIT ;clean up and exit
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 KILL ^XTMP("APCLMUSS",$JOB)
+4 QUIT
+5 PURGE ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Now cleaning up host files older than 7 DAYS"
+2 KILL APCLFILE,APCLDIR
+3 SET APCLDIR=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+4 IF APCLDIR=""
SET APCLDIR=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+5 IF APCLDIR=""
QUIT
+6 SET APCLASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+7 SET APCLDT=$$FMADD^XLFDT(DT,-31)
+8 SET APCLDT=$$DATE^APCLSILI(APCLDT)
+9 SET APCLFLST=$$LIST^%ZISH(APCLDIR,"MU2_"_APCLASU_"*",.APCLFILE)
+10 IF '$ORDER(APCLFILE(""))
QUIT
+11 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLFILE(APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+12 SET D=$PIECE($PIECE(APCLFILE(APCLX),"."),"_",3)
+13 IF D<APCLDT
SET N=APCLFILE(APCLX)
SET APCLM=$$DEL^%ZISH(APCLDIR,N)
End DoDot:1
+14 QUIT
+15 ;
DATEXP ;-- ask the date range
+1 DO EN^XBVK("APCL")
+2 SET APCLSITE=$PIECE($GET(^AUTTSITE(1,0)),U,1)
+3 ;MUST BE SCHEDULED AS MAIN SITE
IF DUZ(2)'=APCLSITE
QUIT
+4 SET APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
+5 SET %DT="AE"
SET %DT("A")="Begin Date: "
+6 DO ^%DT
+7 IF Y<0
DO EXIT
QUIT
+8 SET APCLBD=+Y
+9 SET %DT="AE"
SET %DT("A")="End Date: "
+10 DO ^%DT
+11 IF Y<0
DO EXIT
QUIT
+12 SET APCLED=+Y
+13 SET APCLEXTY="D"
+14 GOTO PROC
+15 QUIT
+16 ;
+17 +18
***** ERRORS & WARNINGS IN APCLSMUN *****
START+22 W - Line contains a CONTROL (non-graphic) character.
START+22 F - Invalid or wrong number of arguments to a function.
START+22 W - Invalid local variable name.
PROC+30 W - Line contains a CONTROL (non-graphic) character.
EXIT+5 W - Null line (no commands or comment).
DATEXP+17 W - Null line (no commands or comment).
DATEXP+18 W - Null line (no commands or comment).
