- ABMDVDSP ; IHS/ASDST/DMJ - DISPLAY A PCC VISIT ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;;Y2K/OK - IHS/ADC/JLG 12-18-97
- ;Original;TMD;
- ;
- Q:'$D(ABMDVDSP)
- Q:'ABMDVDSP
- Q:'$D(^AUPNVSIT(ABMDVDSP,0))
- S APCDVDSP=ABMDVDSP
- D ^APCDVDSP
- K ABMDVDSP,APCDVDSP
- Q
- ;
- D DSPLY
- D EOJ
- Q
- ;
- DSPLY ;
- W $$EN^ABMVDF("IOF") K S,DR
- S ABMDVDSH="-----------------------------"
- S X="",$P(X,"~",80)="" W !,X,!!,ABMDVDSH," VISIT FILE ",ABMDVDSH
- S DIC="^AUPNVSIT(",DA=ABMDVDSP D EN^DIQ
- S ABMDVFLE=9000010 F ABMDVL=0:0 S ABMDVFLE=$O(^DIC(ABMDVFLE)) Q:ABMDVFLE>9000010.99!(ABMDVFLE'=+ABMDVFLE) D DSPLY2 Q:$D(DTOUT)!$D(DUOUT)
- S X="",$P(X,"~",80)="" W !,X
- Q
- ;
- DSPLY2 S ABMDVNM=$P(^DIC(ABMDVFLE,0),U,1)
- S ABMDVDG=^DIC(ABMDVFLE,0,"GL"),ABMDVIGR=ABMDVDG_"""AD"",ABMDVDSP,ABMDVDFN)"
- S ABMDVDFN="" F ABMDVI=1:1 S ABMDVDFN=$O(@ABMDVIGR) Q:ABMDVDFN="" D DSPLY3 Q:$D(DTOUT)!$D(DUOUT)
- Q
- ;
- DSPLY3 I $Y>(IOSL-7) K DIR S DIR(0)="E" D ^DIR K DIR,S Q:$D(DTOUT)!$D(DUOUT) W $$EN^ABMVDF("IOF")
- I ABMDVI<2 S X=20-$L(ABMDVNM),Y=X\2,Z=X-Y W !,ABMDVDSH,$J("",Z),ABMDVNM,$J("",Y),ABMDVDSH
- ;LAB SET S=0 BELOW TO DISABLE THE "^" TO HALT PROMPTS
- S DIC=ABMDVDG,DA=ABMDVDFN,DIQ(0)="C" D EN^DIQ
- Q
- ;
- EOJ ; EOJ CLEANUP
- I '$D(DTOUT),'$D(DUOUT) K DIR S DIR(0)="E" D ^DIR K DIR
- K X,Y
- K ABMDVDFN,ABMDVDG,ABMDVDSH,ABMDVDSP,ABMDVFLE,ABMDVI,ABMDVIGR,ABMDVL,ABMDVNM
- Q
- ABMDVDSP ; IHS/ASDST/DMJ - DISPLAY A PCC VISIT ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;;Y2K/OK - IHS/ADC/JLG 12-18-97
- +3 ;Original;TMD;
- +4 ;
- +5 IF '$DATA(ABMDVDSP)
- QUIT
- +6 IF 'ABMDVDSP
- QUIT
- +7 IF '$DATA(^AUPNVSIT(ABMDVDSP,0))
- QUIT
- +8 SET APCDVDSP=ABMDVDSP
- +9 DO ^APCDVDSP
- +10 KILL ABMDVDSP,APCDVDSP
- +11 QUIT
- +12 ;
- +13 DO DSPLY
- +14 DO EOJ
- +15 QUIT
- +16 ;
- DSPLY ;
- +1 WRITE $$EN^ABMVDF("IOF")
- KILL S,DR
- +2 SET ABMDVDSH="-----------------------------"
- +3 SET X=""
- SET $PIECE(X,"~",80)=""
- WRITE !,X,!!,ABMDVDSH," VISIT FILE ",ABMDVDSH
- +4 SET DIC="^AUPNVSIT("
- SET DA=ABMDVDSP
- DO EN^DIQ
- +5 SET ABMDVFLE=9000010
- FOR ABMDVL=0:0
- SET ABMDVFLE=$ORDER(^DIC(ABMDVFLE))
- IF ABMDVFLE>9000010.99!(ABMDVFLE'=+ABMDVFLE)
- QUIT
- DO DSPLY2
- IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +6 SET X=""
- SET $PIECE(X,"~",80)=""
- WRITE !,X
- +7 QUIT
- +8 ;
- DSPLY2 SET ABMDVNM=$PIECE(^DIC(ABMDVFLE,0),U,1)
- +1 SET ABMDVDG=^DIC(ABMDVFLE,0,"GL")
- SET ABMDVIGR=ABMDVDG_"""AD"",ABMDVDSP,ABMDVDFN)"
- +2 SET ABMDVDFN=""
- FOR ABMDVI=1:1
- SET ABMDVDFN=$ORDER(@ABMDVIGR)
- IF ABMDVDFN=""
- QUIT
- DO DSPLY3
- IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +3 QUIT
- +4 ;
- DSPLY3 IF $Y>(IOSL-7)
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR,S
- IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- WRITE $$EN^ABMVDF("IOF")
- +1 IF ABMDVI<2
- SET X=20-$LENGTH(ABMDVNM)
- SET Y=X\2
- SET Z=X-Y
- WRITE !,ABMDVDSH,$JUSTIFY("",Z),ABMDVNM,$JUSTIFY("",Y),ABMDVDSH
- +2 ;LAB SET S=0 BELOW TO DISABLE THE "^" TO HALT PROMPTS
- +3 SET DIC=ABMDVDG
- SET DA=ABMDVDFN
- SET DIQ(0)="C"
- DO EN^DIQ
- +4 QUIT
- +5 ;
- EOJ ; EOJ CLEANUP
- +1 IF '$DATA(DTOUT)
- IF '$DATA(DUOUT)
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +2 KILL X,Y
- +3 KILL ABMDVDFN,ABMDVDG,ABMDVDSH,ABMDVDSP,ABMDVFLE,ABMDVI,ABMDVIGR,ABMDVL,ABMDVNM
- +4 QUIT
