- APCDVDSP ; IHS/CMI/LAB -VISIT DISPLAY ;
- ;;2.0;IHS PCC SUITE;**2,4,5,10,11,17**;MAY 14, 2009;Build 18
- ;
- EN ;PEP - can be called by other packages
- ;
- Q:'$D(APCDVDSP)
- Q:'APCDVDSP
- Q:'$D(^AUPNVSIT(APCDVDSP,0))
- D DSPLY
- D EOJ
- Q
- ;
- DSPLY ;
- I $D(IOF),'$D(APCDVDSP("NO IOF")) W @IOF
- NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S
- S APCDBRK=0 ;ACC
- S APCDVDSH="-----------------------------"
- S X="",$P(X,"~",80)="" W !!,X,!!,"VISIT IEN: ",APCDVDSP,!
- S X="HRN: "_$$HRN^AUPNPAT($P(^AUPNVSIT(APCDVDSP,0),U,5),DUZ(2),2) W !,X,!
- W APCDVDSH," VISIT FILE ",APCDVDSH
- S DIC="^AUPNVSIT(",DA=APCDVDSP D EN^DIQ
- DSPLY1 ;DISPLAY V FILE DATA
- S APCDVFLE=9000010 F APCDVL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)!(APCDBRK) D DSPLY2 Q:APCDBRK ;ACC
- I 'APCDBRK S X="",$P(X,"~",80)="" W !!,X,!!
- Q
- ;
- DSPLY2 S APCDVNM=$P(^DIC(APCDVFLE,0),U)
- S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)"
- S APCDVDFN="",APCDVI=0 F S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN=""!(APCDBRK) D DSPLY3 Q:APCDBRK ;ACC
- Q
- ;
- DSPLY3 ;
- I APCDVFLE=9000010.01 Q:$P($G(^AUPNVMSR(APCDVDFN,2)),U,1) ;meas entered in error
- I APCDVFLE=9000010.54 Q:$P($G(^AUPNVRUP(APCDVDFN,2)),U,1) ;V updated/reviewed entered in error
- I APCDVFLE=9000010.62 Q:$P($G(^AUPNVAMI(APCDVDFN,5)),U,1) ;V AMI entered in error
- I APCDVFLE=9000010.63 Q:$P($G(^AUPNVSTR(APCDVDFN,5)),U,1) ;V STROKE entered in error
- I APCDVFLE=9000010.51 Q:$P($G(^AUPNVACG(APCDVDFN,1)),U,1) ;V ANTICOAG entered in error
- I APCDVFLE=9000010.58 Q:$P($G(^AUPNVVI(APCDVDFN,0)),U,6) ;V VI entered in error
- I APCDVFLE=9000010.43 Q:$P($G(^AUPNVOB(APCDVDFN,0)),U,6) ;V OB entered in error
- I $Y>(IOSL-5) D HEAD Q:APCDBRK
- I $I(APCDVI)<2 S X=20-$L(APCDVNM),Y=X\2,Z=X-Y W !,APCDVDSH,$J("",Z),APCDVNM,$J("",Y),APCDVDSH
- S DIC=APCDVDG,DA=APCDVDFN,DIQ(0)="C" D EN^DIQ
- I APCDVFLE=9000010.28 S X=$P(^AUPNVNOT(APCDVDFN,0),U) I $$VAL^XBDIQ1(8925,X,.05)="RETRACTED" D
- .W ?2,"DATE RETRACTED: ",$$VAL^XBDIQ1(8925,X,1611),!?2,"RETRACTED BY: ",$$VAL^XBDIQ1(8925,X,1610)
- Q
- ;
- HEAD ;
- I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST)="C",IO=IO(0) W !!,"Enter to continue, '^' to halt " R APCDX:DTIME S:'$T APCDBRK=1 S:APCDX="^" APCDBRK=1
- Q:APCDBRK
- K S
- W:$D(IOF) @IOF
- Q
- EOJ ; EOJ CLEANUP
- I '$D(ZTQUEUED),'$D(IO("S")),'APCDBRK,'$D(APCDEIN),$E(IOST)="C",IO=IO(0) W !,"End of visit display, <ENTER> to Continue" R APCDX:DTIME
- K X,Y
- K APCDVDFN,APCDVDG,APCDVDSH,APCDVDSP,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,APCDX,APCDBRK
- Q
- APCDVDSP ; IHS/CMI/LAB -VISIT DISPLAY ;
- +1 ;;2.0;IHS PCC SUITE;**2,4,5,10,11,17**;MAY 14, 2009;Build 18
- +2 ;
- EN ;PEP - can be called by other packages
- +1 ;
- +2 IF '$DATA(APCDVDSP)
- QUIT
- +3 IF 'APCDVDSP
- QUIT
- +4 IF '$DATA(^AUPNVSIT(APCDVDSP,0))
- QUIT
- +5 DO DSPLY
- +6 DO EOJ
- +7 QUIT
- +8 ;
- DSPLY ;
- +1 IF $DATA(IOF)
- IF '$DATA(APCDVDSP("NO IOF"))
- WRITE @IOF
- +2 NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S
- +3 ;ACC
- SET APCDBRK=0
- +4 SET APCDVDSH="-----------------------------"
- +5 SET X=""
- SET $PIECE(X,"~",80)=""
- WRITE !!,X,!!,"VISIT IEN: ",APCDVDSP,!
- +6 SET X="HRN: "_$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDVDSP,0),U,5),DUZ(2),2)
- WRITE !,X,!
- +7 WRITE APCDVDSH," VISIT FILE ",APCDVDSH
- +8 SET DIC="^AUPNVSIT("
- SET DA=APCDVDSP
- DO EN^DIQ
- DSPLY1 ;DISPLAY V FILE DATA
- +1 ;ACC
- SET APCDVFLE=9000010
- FOR APCDVL=0:0
- SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
- IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)!(APCDBRK)
- QUIT
- DO DSPLY2
- IF APCDBRK
- QUIT
- +2 IF 'APCDBRK
- SET X=""
- SET $PIECE(X,"~",80)=""
- WRITE !!,X,!!
- +3 QUIT
- +4 ;
- DSPLY2 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
- +1 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
- SET APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)"
- +2 ;ACC
- SET APCDVDFN=""
- SET APCDVI=0
- FOR
- SET APCDVDFN=$ORDER(@APCDVIGR)
- IF APCDVDFN=""!(APCDBRK)
- QUIT
- DO DSPLY3
- IF APCDBRK
- QUIT
- +3 QUIT
- +4 ;
- DSPLY3 ;
- +1 ;meas entered in error
- IF APCDVFLE=9000010.01
- IF $PIECE($GET(^AUPNVMSR(APCDVDFN,2)),U,1)
- QUIT
- +2 ;V updated/reviewed entered in error
- IF APCDVFLE=9000010.54
- IF $PIECE($GET(^AUPNVRUP(APCDVDFN,2)),U,1)
- QUIT
- +3 ;V AMI entered in error
- IF APCDVFLE=9000010.62
- IF $PIECE($GET(^AUPNVAMI(APCDVDFN,5)),U,1)
- QUIT
- +4 ;V STROKE entered in error
- IF APCDVFLE=9000010.63
- IF $PIECE($GET(^AUPNVSTR(APCDVDFN,5)),U,1)
- QUIT
- +5 ;V ANTICOAG entered in error
- IF APCDVFLE=9000010.51
- IF $PIECE($GET(^AUPNVACG(APCDVDFN,1)),U,1)
- QUIT
- +6 ;V VI entered in error
- IF APCDVFLE=9000010.58
- IF $PIECE($GET(^AUPNVVI(APCDVDFN,0)),U,6)
- QUIT
- +7 ;V OB entered in error
- IF APCDVFLE=9000010.43
- IF $PIECE($GET(^AUPNVOB(APCDVDFN,0)),U,6)
- QUIT
- +8 IF $Y>(IOSL-5)
- DO HEAD
- IF APCDBRK
- QUIT
- +9
- *** ERROR ***
- IF $I(APCDVI)<2
- SET X=20-$LENGTH(APCDVNM)
- SET Y=X\2
- SET Z=X-Y
- WRITE !,APCDVDSH,$JUSTIFY("",Z),APCDVNM,$JUSTIFY("",Y),APCDVDSH
- +10 SET DIC=APCDVDG
- SET DA=APCDVDFN
- SET DIQ(0)="C"
- DO EN^DIQ
- +11 IF APCDVFLE=9000010.28
- SET X=$PIECE(^AUPNVNOT(APCDVDFN,0),U)
- IF $$VAL^XBDIQ1(8925,X,.05)="RETRACTED"
- Begin DoDot:1
- +12 WRITE ?2,"DATE RETRACTED: ",$$VAL^XBDIQ1(8925,X,1611),!?2,"RETRACTED BY: ",$$VAL^XBDIQ1(8925,X,1610)
- End DoDot:1
- +13 QUIT
- +14 ;
- HEAD ;
- +1 IF '$DATA(ZTQUEUED)
- IF '$DATA(IO("S"))
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !!,"Enter to continue, '^' to halt "
- READ APCDX:DTIME
- IF '$TEST
- SET APCDBRK=1
- IF APCDX="^"
- SET APCDBRK=1
- +2 IF APCDBRK
- QUIT
- +3 KILL S
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 QUIT
- EOJ ; EOJ CLEANUP
- +1 IF '$DATA(ZTQUEUED)
- IF '$DATA(IO("S"))
- IF 'APCDBRK
- IF '$DATA(APCDEIN)
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !,"End of visit display, <ENTER> to Continue"
- READ APCDX:DTIME
- +2 KILL X,Y
- +3 KILL APCDVDFN,APCDVDG,APCDVDSH,APCDVDSP,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,APCDX,APCDBRK
- +4 QUIT
