| [613] | 1 | DVBACRRP ;ALB/GTS-557/THM-REPRINT 21-DAY CERT FOR MAS ;21 JUL 89
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | D INIT
|
|---|
| 4 | I 'CONT G KIL
|
|---|
| 5 | S DVBSEL=$$SELECT^DVBAUTL5("Original Processing Date","21 Day Certificate")
|
|---|
| 6 | I DVBSEL="D" S SDATE=$$DATE() G:SDATE<0 KIL
|
|---|
| 7 | I DVBSEL="N" S XDA=$$PAT^DVBAUTL5("MAS") G:XDA<1 KIL
|
|---|
| 8 | I DVBSEL=0 G KIL
|
|---|
| 9 | D DEVICE
|
|---|
| 10 | I 'CONT G KIL
|
|---|
| 11 | D DATA
|
|---|
| 12 | ;
|
|---|
| 13 | KIL D KILL
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | DATA ;
|
|---|
| 17 | I DVBSEL="D" DO
|
|---|
| 18 | .U IO
|
|---|
| 19 | .S NAME=""
|
|---|
| 20 | .F J=0:0 S NAME=$O(^DVB(396,"B",NAME)) Q:NAME="" F XDA=0:0 S XDA=$O(^DVB(396,"B",NAME,XDA)) Q:XDA="" I $P(^DVB(396,XDA,0),U,14)=SDATE S DFN=$P(^(0),U,1) D CREATE
|
|---|
| 21 | .Q
|
|---|
| 22 | I DVBSEL="N" DO
|
|---|
| 23 | .S DFN=$P(^DVB(396,XDA,0),U,1)
|
|---|
| 24 | .D CREATE
|
|---|
| 25 | .Q
|
|---|
| 26 | I NODTA=0 DO
|
|---|
| 27 | .S VAR(1,0)="0,0,0,2:2,0^No data found to reprint"
|
|---|
| 28 | .D WR^DVBAUTL4("VAR")
|
|---|
| 29 | .K VAR
|
|---|
| 30 | .Q
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | KILL K %DT(0),SDATE,DVBAON2,DVBSEL,VAR,CONT
|
|---|
| 34 | I $D(ZTQUEUED) D KILL^%ZTLOAD
|
|---|
| 35 | D KILL^DVBAUTIL
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | CREATE ;CERTIFICATE CREATE
|
|---|
| 39 | Q:'$D(^DVB(396,XDA,4))
|
|---|
| 40 | I $D(^DVB(396,XDA,2)) Q:$P(^(2),U,10)="L"
|
|---|
| 41 | I '$D(^DPT(DFN,0)) W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
|
|---|
| 42 | I '$D(^DPT(DFN,0)) W !!,"Patient record missing for DFN ",DFN,!!
|
|---|
| 43 | I '$D(^DPT(DFN,0)) S DVBAON2="" Q
|
|---|
| 44 | 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")
|
|---|
| 45 | S WARD=$P(^DVB(396,XDA,4),U,6),BED=$P(^(4),U,7),DCHGDT=$P(^(4),U,5),ADMDT=$P(^(0),U,4)
|
|---|
| 46 | U IO W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
|
|---|
| 47 | 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,!!!
|
|---|
| 48 | 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:",!!!!!!!!!!!!!!!!!!!!
|
|---|
| 49 | W "Physician signature: " F LINE=$X:1:80 W "_"
|
|---|
| 50 | W !!!," Approved by: " F LINE=$X:1:65 W "_"
|
|---|
| 51 | W !!?5,"R0C 119",!
|
|---|
| 52 | S NODTA=1
|
|---|
| 53 | S DVBAON2=""
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | INIT ;
|
|---|
| 57 | K ^TMP($J)
|
|---|
| 58 | S CONT=1,NODTA=0,HD="21-DAY CERTIFICATE REPRINTING"
|
|---|
| 59 | D HOME^%ZIS
|
|---|
| 60 | D NOPARM^DVBAUTL2
|
|---|
| 61 | I $D(DVBAQUIT) S CONT=0 Q
|
|---|
| 62 | S HD1=$$SITE^DVBCUTL4()
|
|---|
| 63 | I '$D(DT) S X="T" D ^%DT S DT=Y
|
|---|
| 64 | S Y=DT X ^DD("DD") S FDT(0)=Y
|
|---|
| 65 | S VAR(1,0)="0,0,(IOM-$L(HD)\2),1:3,1:0^"_HD
|
|---|
| 66 | D WR^DVBAUTL4("VAR")
|
|---|
| 67 | K VAR
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | DATE() ;THis function returns a date of the original request from the user.
|
|---|
| 71 | S %DT(0)=-DT
|
|---|
| 72 | S %DT("A")="Enter ORIGINAL PROCESSING DATE: ",%DT="AEQ"
|
|---|
| 73 | D ^%DT
|
|---|
| 74 | K %DT
|
|---|
| 75 | Q Y
|
|---|
| 76 | ;
|
|---|
| 77 | DEVICE ;
|
|---|
| 78 | S VAR(1,0)="0,0,0,2:0,0^"
|
|---|
| 79 | D WR^DVBAUTL4("VAR")
|
|---|
| 80 | K VAR
|
|---|
| 81 | S %ZIS="AEQ"
|
|---|
| 82 | D ^%ZIS K %ZIS
|
|---|
| 83 | I POP S CONT=0 Q
|
|---|
| 84 | I $D(IO("Q")) DO
|
|---|
| 85 | .S CONT=0
|
|---|
| 86 | .S ZTIO=ION,ZTDESC="21-day Cert reprint",ZTRTN="DATA^DVBACRRP"
|
|---|
| 87 | .F I="XDA","DVBSEL","FDT(0)","HD","HD1","SDATE","NODTA" S ZTSAVE(I)=""
|
|---|
| 88 | .D ^%ZTLOAD
|
|---|
| 89 | .D ^%ZISC
|
|---|
| 90 | .I $D(ZTSK) DO
|
|---|
| 91 | ..S VAR(1,0)="0,0,0,2:2,0^Request queued."
|
|---|
| 92 | ..D WR^DVBAUTL4("VAR")
|
|---|
| 93 | ..K VAR
|
|---|
| 94 | ..Q
|
|---|
| 95 | .Q
|
|---|
| 96 | Q
|
|---|
