| [613] | 1 | DVBHQUS ;ISC-ALBANY/PKE-CHECK STATUS in suspense ; 04 OCT 85 4:07 pm
|
|---|
| 2 | ;;4.0;HINQ;**31**;03/25/92
|
|---|
| 3 | LK S X=0,DIC="^DPT(",DIC(0)="AEMQ" D ^DIC Q:Y'>0 S X=+Y
|
|---|
| 4 | UP I X S DIC="^DVB(395.5,",DIC(0)="NQ" D ^DIC S DFN=+Y I Y'>0 W !,?22,"Patient not in Suspense file" G LK
|
|---|
| 5 | Q
|
|---|
| 6 | FIND D LK I Y>0 D UP I Y>0 S Y0=$Y,Y1=0 S IOP="HOME" D ^%ZIS K IOP D CODE W !! D WRTMESS,VER K Y0,R,R1 G FIND
|
|---|
| 7 | ;
|
|---|
| 8 | K DVBIXMZ
|
|---|
| 9 | EX K DIC,I,DVBLN,DVBUSER,DVBI,DFN,R,R1,Y,Y0,Y1,X,Y,Z,C,G,DR,DIC,DA,D0 QUIT
|
|---|
| 10 | Q
|
|---|
| 11 | FILM ;
|
|---|
| 12 | S DFN=D0 S Y0=$Y D CODE W !! D WRTMESS Q
|
|---|
| 13 | Q
|
|---|
| 14 | CODE Q:'$D(DFN) F G=3,4,5 I $D(^DD(395.5,G,0)) S R(G)=$P(^(0),U)
|
|---|
| 15 | S R(8)="Last Updated",Y1="" I $D(^DVB(395.7,DFN,0)) S Y1=$P(^(0),U,3)
|
|---|
| 16 | Q:'$D(^DVB(395.5,DFN,0)) S Y=$P(^(0),U,3),Z=$P(^(0),U,4),Y0=$P(^(0),U,6),DVBI=$P(^(0),U,5),DVBI=$S(DVBI="Y":"YES",1:"NO"),Z=$S(Z="P":"Pending",Z="N":"NEWMAIL",Z="E":"Error",Z="V":"IDCU Error",Z="A":"Abbreviated",1:"")
|
|---|
| 17 | D TM W @IOF S Y0=$Y W !!,R(3),": ",Y,?46,R(4),?61,": ",Z
|
|---|
| 18 | S Y=Y1 D TM S Y1=Y W !,R(5),?21,": ",DVBI,?46,R(8),?61,": ",Y1
|
|---|
| 19 | K R1 F DVBUSER=0:0 S DVBUSER=$O(^DVB(395.5,DFN,1,DVBUSER)) Q:'DVBUSER S:$D(^DVB(395.5,DFN,1,DVBUSER,0)) R1(DVBUSER)=$P(^(0),U,2)
|
|---|
| 20 | USER F DVBUSER=0:0 S DVBUSER=$O(R1(DVBUSER)) Q:'DVBUSER I $D(^VA(200,DVBUSER,0)) W !,"REQUESTED BY",?21,": ",$E($P(^(0),U,1),1,23),?46 S Y=R1(DVBUSER) D TM W "TIME OF REQUEST",?61,": ",Y
|
|---|
| 21 | Q
|
|---|
| 22 | TM S Y=$E(Y,1,12),Y=$$FMTE^XLFDT(Y,"5F"),Y=$TR(Y," ","0") Q
|
|---|
| 23 | ;
|
|---|
| 24 | WRTMESS Q:'$D(^DVB(395.5,$S($D(DFN):DFN,1:0),0)) S DVBIXMZ=$P(^(0),U,7) Q:'DVBIXMZ
|
|---|
| 25 | S:'$D(Y0) Y0=$Y
|
|---|
| 26 | Q:'$D(^XMB(3.9,DVBIXMZ,0)) S Y=$P(^(0),U,3) D TM W $P(^(0),U)," ",Y,!
|
|---|
| 27 | F DVBLN=1:1 Q:'$D(^XMB(3.9,DVBIXMZ,2,DVBLN,0)) W $E(^(0),1,80),! W:$L(^(0))>80 $E(^(0),81,150),! W:$L(^(0))>150 $E(^(0),151,226),! D:($Y-Y0)>(IOSL-3-Y1) SCROL Q:X="^" D:$Y<Y0 ABS
|
|---|
| 28 | K DVBSCROL Q
|
|---|
| 29 | ABS S Y0=255-Y0 Q:$Y+Y0<(IOSL-3-Y1)
|
|---|
| 30 | SCROL I $E(IOST,1)["C" W !,"Press return to continue "_$C(7) R X:DTIME Q:'$T!(X="^") S Y0=$Y,Y1=0 W ! Q
|
|---|
| 31 | I $E(IOST,1)'["C",$Y>64 W @IOF Q
|
|---|
| 32 | Q
|
|---|
| 33 | VER Q:X["^" I $D(^DPT(DFN,.361)) S Z=$P(^(.361),"^",1) W !,?10,"***ELIGIBILITY ",$S(Z="P":"PENDING VERIFICATION",Z="R":"PENDING RE-VERIFICATION",Z="V":"VERIFIED",1:"NOT VERIFIED"),"***",! Q
|
|---|
| 34 | W !!,?10,"***ELIGIBILITY NOT VERIFIED***",! Q
|
|---|
| 35 | ;
|
|---|
| 36 | EN D LK I Y>0 D UP I Y>0 S DR="0:99",DIC="^DVB(395.5,",DA=DFN D VER,EN^DIQ G EN
|
|---|
| 37 | G EX
|
|---|
