source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1BA.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBDF1BA ;ALB/CJM - ENCOUNTER FORM (user options for printing - continuation of IBDF1B); 3/1/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**25,34**;APR 24, 1997
3 ;
4TERMSTRT ;get terminal digit to restart from - OUTPUT=IBREPRNT
5 S IBREPRNT="",DIR(0)="F^4:5",DIR("A")="ENTER THE LAST 4 DIGITS OF THE SSN TO BEGIN REPRINT FROM",DIR("?")="ENTER THE LAST FOUR DIGITS OF THE SSN OF THE LAST PATIENT FOR WHOM FORMS WERE PRINTED"
6 F D ^DIR Q:$D(DIRUT)!(Y=-1) D Q:IBREPRNT'=""
7 .I Y'?4N W !,$C(7),"MUST BE 4 NUMBERS!" Q
8 .S IBREPRNT=Y,IBREPRNT=+($E(IBREPRNT,3,4)_$E(IBREPRNT,1,2))
9 K DIR
10 Q
11CLNCSTRT ;get clinic and division to restart from,OUTPUT=IBREPRNT (name of clinic) and IBSTRTDV (division to restart from)
12 ;
13 N NODE
14 S IBREPRNT=""
15 S DIR(0)="409.95,.01",DIR("A")="ENTER CLINIC TO BEGIN REPRINT FROM",DIR("?")="ENTER THE LAST CLINIC FOR WHICH ANY FORMS WERE PRINTED"
16 D ^DIR K DIR I $D(DIRUT)!(+Y<0) Q
17 S NODE=$G(^SC(+Y,0))
18 S IBREPRNT=$P(NODE,"^")
19 S IBSTRTDV=+$P(NODE,"^",15) I IBSTRTDV S IBSTRTDV=$P($G(^DG(40.8,IBSTRTDV,0)),"^")
20 Q
21 ;
22SEARCH ;get the appointment data on a patient, put in IBTMP array, indexed by appointment
23 ;screens out any appts in clinics with nothing defined to print
24 N IBX,IBLN,CLINIC,APPT
25 S (VASD("F"),VASD("T"))=IBDT,VASD("W")=129 D SDA^VADPT Q:(VAERR!'$D(^UTILITY("VASD",$J)))
26 S IBX="" F S IBX=$O(^UTILITY("VASD",$J,IBX)) Q:IBX="" D
27 . S IBLN=^UTILITY("VASD",$J,IBX,"I"),APPT=+$P(IBLN,"^"),CLINIC=$P(IBLN,"^",2)
28 .Q:'APPT!'CLINIC
29 .Q:'($D(^SD(409.95,"B",CLINIC))!$D(^SD(409.96,"B",+$$DIVISION^IBDF1B5(CLINIC))))
30 .;^UTILITY("VASD",$J,IBX,"E")=(EXTERNAL FORMAT) appt date time^clinic name^status^appt type
31 .S IBTMP(APPT)=DFN_"^"_CLINIC_"^"_IBNM_"^"_^UTILITY("VASD",$J,IBX,"E")
32 K VASD,VAERR,^UTILITY("VASD",$J)
33 Q
34 ;
35DISP ;display patients/clinics appointments found and get users choice
36 ;sort type is by clinic,patient
37 N CLNCIEN,CLNCNAME
38 I '$D(IBTMP) W !!,?5,"No Active Appointments for ",IBNM," on",!,"this date in any clinic or division that has forms or reports defined to print",! G ENDDISP
39 I '$D(IBTMP) W !!,?10,"No Active Appointments in a Clinic with an Encounter Form",!,?10,"for ",IBNM," on this date.",! G ENDDISP
40 W !!,"Appointments for ",IBNM,!
41 S IBX="" F IBI=1:1 S IBX=$O(IBTMP(IBX)) Q:IBX="" S IBLN=IBTMP(IBX) W !,$J(IBI,3)," ",$E($P(IBLN,"^",5),1,20),?25," " F IBJ=4,6,7 W " ",$P(IBLN,"^",IBJ)
42 S DIR(0)="LO^1:"_(IBI-1),DIR("A")=" Select Appointments" D ^DIR K DIR G:$D(DIRUT) ENDDISP
43 S IBX="" F IBI=1:1 S IBX=$O(IBTMP(IBX)) Q:IBX="" I Y[(IBI_",") D
44 .S CLNCIEN=$P(IBTMP(IBX),"^",2),CLNCNAME=$P(IBTMP(IBX),"^",5)
45 .;
46 .;list format - ^TMP("IBDF",$J,"P"," ",division name(but set it to " " because for selecting single appts sort by division not needed),clinic name,clinic ien,patient name,dfn,appt)=""
47 .;S ^TMP("IBDF",$J,"P"," ",CLNCNAME,CLNCIEN,IBNM,DFN,IBX)=""
48 .S ^TMP("IBDF",$J,"P"," ",$E(CLNCNAME,1,25),CLNCIEN,$E(IBNM,1,25),DFN,IBX)=""
49 .;also keep an index by ...,"APPT LIST",DFN,APPT)
50 .S ^TMP("IBDF",$J,"APPT LIST",DFN,IBX)=""
51ENDDISP K IBTMP,IBX,IBI,IBJ,IBLN,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,^UTILITY("VASD",$J)
52 Q
53 ;
54STARTDIV() ;asks what division to restart the job from and returns division name, or "" if user declines
55 N IBDIV
56 K DIC S DIC="^DG(40.8,",DIC(0)="AEQMN",DIC("A")="SELECT THE DIVISION TO START THE REPRINT FROM: "
57 S IBDIV=$O(^DG(40.8,0)) S:IBDIV DIC("B")=$P($G(^DG(40.8,IBDIV,0)),"^")
58 D ^DIC K DIC
59 I (+Y<0)!$D(DTOUT)!$D(DUOUT) Q ""
60 Q $P(Y,"^",2)
61SORTBY ;sort by clinic/patient, clinic/terminal digit, or terminal digit?
62 K DIR S DIR(0)="S^1:Division/Clinic/Patient Name;2:Division/Terminal Digits;3:Division/Clinic/Terminal Digits"
63 S DIR("?")="Enter '1' for sorting by Division/Clinic/Patient Name or '2' to sort by Division/Terminal Digits or '3' to sort by Division/Clinic/Terminal Digits."
64 S DIR("A")="How should the output be SORTED?",DIR("B")="1" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
65 I Y'=1,Y'=2,Y'=3 S QUIT=1 Q
66 S IBSRT=Y
67 Q
Note: See TracBrowser for help on using the repository browser.