| 1 | DVBACRMS ;ALB/GTS-557/THM-PRINT 21-DAY CERT FOR RO ;21 JUL 89
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | D DUZ2^DVBAUTIL G:$D(DVBAQUIT) KILL
|
|---|
| 4 | I '$D(^DVB(396,"AC",DVBAD2,"R")) W !!,*7,"There are no new 21-DAY CERTIFICATES to print.",! H 2 Q
|
|---|
| 5 | I $D(DUZ)#2=0 W !!,*7,"Your USER NUMBER is missing. Call the site manager.",!! H 3 G KILL
|
|---|
| 6 | S HD="REGIONAL OFFICE 21-DAY CERTIFICATE PRINTING" D HOME^%ZIS D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),HD1=$P(DTAR,U,1)
|
|---|
| 7 | S OPER=$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown")
|
|---|
| 8 | I '$D(DT) S X="T" D ^%DT S DT=Y
|
|---|
| 9 | S Y=DT X ^DD("DD") S FDT(0)=Y
|
|---|
| 10 | W @IOF,!?(IOM-$L(HD)\2),HD,!!!,"This program generates ORIGINAL Regional Office 21-day certificates.",!!
|
|---|
| 11 | W !! S %ZIS="AEQ" D ^%ZIS K %ZIS G:POP KILL
|
|---|
| 12 | I $D(IO("Q")) S ZTIO=ION,ZTDESC="Original RO 21-day Cert Printing",ZTRTN="DATA^DVBACRMS" F I="DVBAD2","HD","HD1","OPER","FDT(0)" S ZTSAVE(I)=""
|
|---|
| 13 | I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! K ZTSK,ZTIO,ZTRTN,ZTDESC G KILL
|
|---|
| 14 | G DATA
|
|---|
| 15 | ;
|
|---|
| 16 | DATA U IO F XDA=0:0 S XDA=$O(^DVB(396,"AC",DVBAD2,"R",XDA)) Q:XDA="" S DFN=$P(^DVB(396,XDA,0),U,1) D CREATE
|
|---|
| 17 | ;
|
|---|
| 18 | KILL K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL
|
|---|
| 19 | ;
|
|---|
| 20 | CREATE ;CERTIFICATE CREATE
|
|---|
| 21 | ;Note: DCHGDT becomes a pseudo-discharge date, that is the date the
|
|---|
| 22 | ; report was run and he became eligible for a 21-day cert.
|
|---|
| 23 | I $D(^DVB(396,XDA,2)) Q:$P(^(2),U,10)="L"
|
|---|
| 24 | I '$D(^DPT(DFN,0)) W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
|
|---|
| 25 | I '$D(^DPT(DFN,0)) W !!,"Patient record missing for DFN ",DFN,!!
|
|---|
| 26 | I '$D(^DPT(DFN,0)) S DVBAON2="" Q
|
|---|
| 27 | 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")
|
|---|
| 28 | S WARD=$P(^DVB(396,XDA,4),U,6),BED=$P(^(4),U,7),DCHGDT=$P(^(4),U,5),ADMDT=$P(^(0),U,4)
|
|---|
| 29 | U IO W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
|
|---|
| 30 | W !,FDT(0),?32,"REPORT OF CONTACT",!,?31,"21-DAY CERTIFICATE",?(80-11),"PAGE: 1",!,?(80-$L(HD1)\2),HD1,!!!!!!!,"Patient name: ",?16,PNAM,!,?9,"SSN: ",?16,SSN,?33,"Claim #: ",?43,CNUM,!!,?9,"Ward: ",?16,WARD,?30,"Bed: ",?36,BED,!!!
|
|---|
| 31 | W " The patient above has been hospitalized for 21 consecutive days ",!,"from " S Y=ADMDT X ^DD("DD") W Y," to " S Y=DCHGDT X ^DD("DD") W Y,", and the major diagnosis for",!,"this period is:",!!!
|
|---|
| 32 | K ^UTILITY($J,"W")
|
|---|
| 33 | F LINE=0:0 S LINE=$O(^DVB(396,XDA,3,LINE)) Q:LINE="" S X=^(LINE,0),DIWL=5,DIWR=75,DIWF="NW" D ^DIWP
|
|---|
| 34 | D ^DIWW W !!!,"A signed copy of this document is on file at "_HD1,!
|
|---|
| 35 | W !!?5,"R0C 119",!
|
|---|
| 36 | S DIE="^DVB(396,",DA=XDA,DR="6.82///P;6.85///"_DT_";6.89///"_OPER D ^DIE
|
|---|
| 37 | S DVBAON2=""
|
|---|
| 38 | Q
|
|---|
