- BSDAMR2 ; IHS/ANMC/LJF - APPTS REQ ACTION ;
- ;;5.3;PIMS;**1007**;FEB 27, 2007
- ;
- ;cmi/anch/maw 11/22/2006 PATCH 1007 added code in INIT for item 1007.17
- ;
- ASK ; -- ask user questions
- NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT
- ;
- S BSDSUB=$$READ^BDGF("SO^C:Clinic;P:Principal Clinic;V:Provider;T:Team","Subtotal Report by","","^D HELP1^BSDWKR1")
- Q:BSDSUB="" Q:BSDSUB=U
- ;
- ; get clinic arrays based on subtotal category
- I (BSDSUB="C")!(BSDSUB="P") D CLINIC^BSDU(2) Q:$D(BSDQ)
- I (BSDSUB="V")!(BSDSUB="T") D PCASK^BSDU(2,BSDSUB) Q:$D(BSDQ)
- ;
- S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
- S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED
- ;
- S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
- D ZIS^BDGF("PQ","START^BSDAMR2","APPT REQ ACTION","BSDSUB;BSDBD;BSDED;VAUTC*;VAUTD*")
- Q
- ;
- START ;EP; -- re-entry for printing to paper
- D INIT,PRINT Q
- ;
- EN ; -- main entry point for BSDRM APPT MGT NO ACTION
- NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
- D EN^VALM("BSDRM APPT MGT NO ACTION")
- D CLEAR^VALM1
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)=$$SP(15)_$$CONF^BSDU
- S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
- Q
- ;
- INIT ; -- init variables and list array
- S VALMCNT=0 K ^TMP("BSDAMR2",$J),^TMP("BSD",$J)
- NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
- ;
- ; -- loop by clinic
- NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,END,LINE
- S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
- . Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
- . S NAME=$$GET1^DIQ(44,CLN,.01) ;set clinic's name
- . S SUB=$$SUB1^BSDWKR1(CLN,NAME) ;get subcategory for clinic
- . I '$G(VAUTD) Q:'$D(VAUTD(+$P($G(^SC(CLN,0)),U,15))) ;cmi/anch/maw 11/22/06 added to screen on division item 1007.17 patch 1007
- . ;
- . ; -- then by appt date (within range)
- . S APPT=BSDBD,END=BSDED+.2400
- . F S APPT=$O(^SC(CLN,"S",APPT)) Q:'APPT!(APPT>END) D
- .. ;
- .. ; -- then find appts to count
- .. S APPN=0
- .. F S APPN=$O(^SC(CLN,"S",APPT,1,APPN)) Q:'APPN D
- ... S PAT=+^SC(CLN,"S",APPT,1,APPN,0) ;patient ien
- ... S STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100) ;current status
- ... I STATUS]"",STATUS'["NO ACTION TAKEN" Q
- ... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS) ;type of appt
- ... ;
- ... ; put appts into display array
- ... S LINE=$$PAD($$FMTE^XLFDT(APPT),22) ;appt date
- ... S LINE=$$PAD(LINE_TYPE,33) ;appt type
- ... S LINE=LINE_$J($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7) ;chart#
- ... S LINE=$$PAD(LINE,43)_$E($$GET1^DIQ(2,PAT,.01),1,18) ;patient name
- ... S LINE=$$PAD(LINE,63)_$$GET1^DIQ(2,PAT,.02,"I") ;sex
- ... S LINE=$$PAD(LINE,68)_$$GET1^DIQ(2,PAT,.033) ;age
- ... S ^TMP("BSD",$J,SUB,NAME,APPT)=LINE ;sort by category,clinic,date
- ;
- ; put sorted list into display array
- NEW S1,S2,S3
- S S1=0 F S S1=$O(^TMP("BSD",$J,S1)) Q:S1="" D
- . D SET(S1,.VALMCNT)
- . S S2=0 F S S2=$O(^TMP("BSD",$J,S1,S2)) Q:S2="" D
- .. I S1'=S2 D SET($$SP(2)_S2,.VALMCNT)
- .. S S3=0 F S S3=$O(^TMP("BSD",$J,S1,S2,S3)) Q:S3="" D
- ... D SET(^TMP("BSD",$J,S1,S2,S3),.VALMCNT)
- .. I S1'=S2 D SET("",.VALMCNT)
- . D SET("",.VALMCNT)
- ;
- K ^TMP("BSD",$J)
- Q
- ;
- TYPE(C,D,N,P,S) ; return type of appt
- ; returns sched, same day, walk-in, overbook, inpt
- I S["INPAT" Q "Inpatient"
- I $G(^SC(C,"S",D,1,N,"OB"))="O" Q "Overbook"
- NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q "Walkin"
- I X=3,(D\1)=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q "Same Day"
- I X=3 Q "Scheduled"
- Q "??" ;error in case one slips thru
- ;
- SET(LINE,NUM) ; set line into display array
- S NUM=NUM+1
- S ^TMP("BSDAMR2",$J,NUM,0)=LINE
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("BSDAMR2",$J)
- Q
- ;
- EXPND ; -- expand code
- Q
- ;
- PRINT ; print report to paper
- U IO D HDG
- NEW X S X=0 F S X=$O(^TMP("BSDAMR2",$J,X)) Q:'X D
- . I $Y>(IOSL-4) D HDG
- . W !,^TMP("BSDAMR2",$J,X,0)
- D ^%ZISC,EXIT
- Q
- ;
- HDG ; heading for paper report
- D HDR W @IOF,?30,"Appointments with No Action Taken"
- F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
- W !,$$REPEAT^XLFSTR("-",80)
- W !,"Appt Date",?22,"Type",?33,"Chart #",?43,"Sex",?48,"Age",?57,"Status"
- W !,$$REPEAT^XLFSTR("=",80)
- Q
- ;
- PAD(D,L) ;EP -- SUBRTN to pad length of data
- ; -- D=data L=length
- Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
- ;
- SP(N) ; -- SUBRTN to pad N number of spaces
- Q $$PAD(" ",N)
- BSDAMR2 ; IHS/ANMC/LJF - APPTS REQ ACTION ;
- +1 ;;5.3;PIMS;**1007**;FEB 27, 2007
- +2 ;
- +3 ;cmi/anch/maw 11/22/2006 PATCH 1007 added code in INIT for item 1007.17
- +4 ;
- ASK ; -- ask user questions
- +1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT
- +2 ;
- +3 SET BSDSUB=$$READ^BDGF("SO^C:Clinic;P:Principal Clinic;V:Provider;T:Team","Subtotal Report by","","^D HELP1^BSDWKR1")
- +4 IF BSDSUB=""
- QUIT
- IF BSDSUB=U
- QUIT
- +5 ;
- +6 ; get clinic arrays based on subtotal category
- +7 IF (BSDSUB="C")!(BSDSUB="P")
- DO CLINIC^BSDU(2)
- IF $DATA(BSDQ)
- QUIT
- +8 IF (BSDSUB="V")!(BSDSUB="T")
- DO PCASK^BSDU(2,BSDSUB)
- IF $DATA(BSDQ)
- QUIT
- +9 ;
- +10 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
- IF 'BSDBD
- QUIT
- +11 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
- IF 'BSDED
- QUIT
- +12 ;
- +13 ;browse in list mgr mode
- SET Y=$$BROWSE^BDGF
- IF "PB"'[Y
- QUIT
- IF Y="B"
- DO EN
- QUIT
- +14 DO ZIS^BDGF("PQ","START^BSDAMR2","APPT REQ ACTION","BSDSUB;BSDBD;BSDED;VAUTC*;VAUTD*")
- +15 QUIT
- +16 ;
- START ;EP; -- re-entry for printing to paper
- +1 DO INIT
- DO PRINT
- QUIT
- +2 ;
- EN ; -- main entry point for BSDRM APPT MGT NO ACTION
- +1 NEW VALMCNT
- DO TERM^VALM0
- DO CLEAR^VALM1
- +2 DO EN^VALM("BSDRM APPT MGT NO ACTION")
- +3 DO CLEAR^VALM1
- +4 QUIT
- +5 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)=$$SP(15)_$$CONF^BSDU
- +2 SET VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
- +3 QUIT
- +4 ;
- INIT ; -- init variables and list array
- +1 SET VALMCNT=0
- KILL ^TMP("BSDAMR2",$JOB),^TMP("BSD",$JOB)
- +2 NEW BSDAR
- SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")
- +3 ;
- +4 ; -- loop by clinic
- +5 NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,END,LINE
- +6 SET CLN=0
- FOR
- SET CLN=$ORDER(@BSDAR@(CLN))
- IF 'CLN
- QUIT
- Begin DoDot:1
- +7 ;quit if principal clinic
- IF $DATA(^SC("AIHSPC",CLN))
- QUIT
- +8 ;set clinic's name
- SET NAME=$$GET1^DIQ(44,CLN,.01)
- +9 ;get subcategory for clinic
- SET SUB=$$SUB1^BSDWKR1(CLN,NAME)
- +10 ;cmi/anch/maw 11/22/06 added to screen on division item 1007.17 patch 1007
- IF '$GET(VAUTD)
- IF '$DATA(VAUTD(+$PIECE($GET(^SC(CLN,0)),U,15)))
- QUIT
- +11 ;
- +12 ; -- then by appt date (within range)
- +13 SET APPT=BSDBD
- SET END=BSDED+.2400
- +14 FOR
- SET APPT=$ORDER(^SC(CLN,"S",APPT))
- IF 'APPT!(APPT>END)
- QUIT
- Begin DoDot:2
- +15 ;
- +16 ; -- then find appts to count
- +17 SET APPN=0
- +18 FOR
- SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
- IF 'APPN
- QUIT
- Begin DoDot:3
- +19 ;patient ien
- SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
- +20 ;current status
- SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
- +21 IF STATUS]""
- IF STATUS'["NO ACTION TAKEN"
- QUIT
- +22 ;type of appt
- SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)
- +23 ;
- +24 ; put appts into display array
- +25 ;appt date
- SET LINE=$$PAD($$FMTE^XLFDT(APPT),22)
- +26 ;appt type
- SET LINE=$$PAD(LINE_TYPE,33)
- +27 ;chart#
- SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)
- +28 ;patient name
- SET LINE=$$PAD(LINE,43)_$EXTRACT($$GET1^DIQ(2,PAT,.01),1,18)
- +29 ;sex
- SET LINE=$$PAD(LINE,63)_$$GET1^DIQ(2,PAT,.02,"I")
- +30 ;age
- SET LINE=$$PAD(LINE,68)_$$GET1^DIQ(2,PAT,.033)
- +31 ;sort by category,clinic,date
- SET ^TMP("BSD",$JOB,SUB,NAME,APPT)=LINE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 ;
- +33 ; put sorted list into display array
- +34 NEW S1,S2,S3
- +35 SET S1=0
- FOR
- SET S1=$ORDER(^TMP("BSD",$JOB,S1))
- IF S1=""
- QUIT
- Begin DoDot:1
- +36 DO SET(S1,.VALMCNT)
- +37 SET S2=0
- FOR
- SET S2=$ORDER(^TMP("BSD",$JOB,S1,S2))
- IF S2=""
- QUIT
- Begin DoDot:2
- +38 IF S1'=S2
- DO SET($$SP(2)_S2,.VALMCNT)
- +39 SET S3=0
- FOR
- SET S3=$ORDER(^TMP("BSD",$JOB,S1,S2,S3))
- IF S3=""
- QUIT
- Begin DoDot:3
- +40 DO SET(^TMP("BSD",$JOB,S1,S2,S3),.VALMCNT)
- End DoDot:3
- +41 IF S1'=S2
- DO SET("",.VALMCNT)
- End DoDot:2
- +42 DO SET("",.VALMCNT)
- End DoDot:1
- +43 ;
- +44 KILL ^TMP("BSD",$JOB)
- +45 QUIT
- +46 ;
- TYPE(C,D,N,P,S) ; return type of appt
- +1 ; returns sched, same day, walk-in, overbook, inpt
- +2 IF S["INPAT"
- QUIT "Inpatient"
- +3 IF $GET(^SC(C,"S",D,1,N,"OB"))="O"
- QUIT "Overbook"
- +4 NEW X
- SET X=$$VALI^XBDIQ1(2.98,P_","_D,9)
- IF X=4
- QUIT "Walkin"
- +5 IF X=3
- IF (D\1)=($PIECE($GET(^DPT(P,"S",D,0)),U,19)\1)
- QUIT "Same Day"
- +6 IF X=3
- QUIT "Scheduled"
- +7 ;error in case one slips thru
- QUIT "??"
- +8 ;
- SET(LINE,NUM) ; set line into display array
- +1 SET NUM=NUM+1
- +2 SET ^TMP("BSDAMR2",$JOB,NUM,0)=LINE
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("BSDAMR2",$JOB)
- +2 QUIT
- +3 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- PRINT ; print report to paper
- +1 USE IO
- DO HDG
- +2 NEW X
- SET X=0
- FOR
- SET X=$ORDER(^TMP("BSDAMR2",$JOB,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +3 IF $Y>(IOSL-4)
- DO HDG
- +4 WRITE !,^TMP("BSDAMR2",$JOB,X,0)
- End DoDot:1
- +5 DO ^%ZISC
- DO EXIT
- +6 QUIT
- +7 ;
- HDG ; heading for paper report
- +1 DO HDR
- WRITE @IOF,?30,"Appointments with No Action Taken"
- +2 FOR I=1:1
- IF '$DATA(VALMHDR(I))
- QUIT
- WRITE !,VALMHDR(I)
- +3 WRITE !,$$REPEAT^XLFSTR("-",80)
- +4 WRITE !,"Appt Date",?22,"Type",?33,"Chart #",?43,"Sex",?48,"Age",?57,"Status"
- +5 WRITE !,$$REPEAT^XLFSTR("=",80)
- +6 QUIT
- +7 ;
- PAD(D,L) ;EP -- SUBRTN to pad length of data
- +1 ; -- D=data L=length
- +2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
- +3 ;
- SP(N) ; -- SUBRTN to pad N number of spaces
- +1 QUIT $$PAD(" ",N)
