Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA05.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA05.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA05.m
r613 r623 1 SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am 2 ;;5.3;Scheduling;**290,333,349,376,491**;AUG 13, 2003;Build 53 3 ;Evaluation of the appointment status is done from the computed field to match the displayed/printed status in the appointment management 4 ;SD/491 - MODIFIED $$SCHEDULE to cut off appointments considered as rescheduled by with the scheduled date<2250000 5 Q 6 ; 7 STATUS(DFN,SDADT,SDCL,TODAY,SFD) ; 8 ;Input: 9 ; SDADT - Appt date/time 10 ; SDCL - Clinic IEN 11 ; SFD: - 0 - if called from scanning previous runs - update 12 ; - 1 - if called from scanning 2.98 13 ;Output: 14 ; SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL_U_SD8RD 15 ; where: 16 ; SDMSH -HL7 segment 17 ; SD25 - Filler Status: 18 ; P - Pending 19 ; F - Final 20 ; SD6 - Event Reason 21 ; SD8 - Appt Type 22 ; SD8RD - rescheduled date/time if SD8="RS" 23 ; SDCO - check out date 24 ; SDCLL - clinic IEN from matching encounter 25 ; 26 N SD0,SDST,SD6,SD8,SD25,SDMSH,SDCO,SDSTAT,SD8S,SD8RD 27 S SDST=$$GET1^DIQ(2.98,SDADT_","_DFN_",",3,"I") 28 I SDST'="" I SDST'="NT"&(SDST'="I") D Q SDSTAT 29 .S SD25="F",SDCO="",SD8RD="" 30 .I SDST="C" S SD6="CC",SD8="",SDMSH="S15" D ;cancel by clinic 31 ..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2) 32 .I SDST="CA" S SD6="CC",SD8="ABK",SDMSH="S15" ;cancel bt clinic and auto rebook 33 .I SDST="PC" S SD6="CP",SD8="",SDMSH="S15" D ; cancel by patient 34 ..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2) 35 .I SDST="PCA" S SD6="CP",SD8="ABK",SDMSH="S15" ;cancel by patient and auto rebook 36 .I SDST="NA" S SD6="NS",SD8="ABK",SDMSH="S26" ;no show and auto rebook 37 .I SDST="N" S SD6="NS",SD8="",SDMSH="S26" ;no show 38 .;evaluate 'non-count' 39 .I $P($G(^SC(SDCL,0)),U,17)="Y" D 40 ..I SD8="" S SD8="NC" Q 41 ..I SD8="RS" S SD8="RSN" 42 .; 43 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 44 ;process all others 45 S SD0=^DPT(DFN,"S",SDADT,0) 46 ; check out from OUTPAT ENCOUNTER 47 ;N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0 S SDCO=$P(^SCE(SCE,0),"^",7) 48 N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0,$D(^SCE(SCE,0)) S SDCO=$P(^SCE(SCE,0),"^",7) 49 N SDSTATX,SDX3 50 S SDSTATX=$$STATUS^SDAM1(DFN,SDADT,SDCL,SD0) ;call to compute the status (VistA) 51 ;SDSTATX=Appt status IFN in 409.63 ; status name ; print status ; check in ; check out 52 I SDCO="" S SDCO=$P(SDSTATX,";",5) ; check out from clinic if NULL 53 I SDCO'=""&(+SDSTATX'=12) D Q SDSTAT 54 .S SD6="CO",SD25="F",SD8="",SD8RD="",SDMSH=$S(SFD=0:"S14",1:"S12") 55 .I +SDSTATX=3 S SD8="AR" ; action required 56 .I +SDSTATX=8 S SD8="I" ;inpatient 57 .;I +SDSTATX=12 S SD8="NC" ;non-count excluded to be compared to possible encounter does not matter if check out 58 .I +SDSTATX=2 S SD8="O" ;outpatient 59 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 60 I +SDSTATX=3 D Q SDSTAT 61 .S SD25="P",SDMSH="S12",SDCO="",SD8RD="" 62 .I $P(SDSTATX,";",4)'="" S SD6="CI",SD8="AR" ;check in/action required 63 .E S SD6="",SD8="NAT",SD8RD="" ;no action taken 64 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 65 I +SDSTATX=8!(+SDSTATX=11) S SD25="P",SD8RD="" D Q SDSTAT 66 .I +SDSTATX=8 S SD6="",SD8="I",SDCO="",SDMSH="S12" ;inpatient 67 .I +SDSTATX=11 S SD6="",SD8="F",SDCO="",SDMSH="S12" ;future 68 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 69 ; 70 ;process non-count (not checked out) 71 I +SDSTATX=12 N SDCLL S SDCLL="" D S:SD6'="COE" SDCLL=SDCL S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL Q SDSTAT 72 .S SD6="",SD8="NC",SDCO="",SDMSH="S12",SD25="P" 73 .I (SDADT\1)-(TODAY\1)>0 S SD6="",SD8="NCF",SD25="P" Q 74 .N SDADTC,SDSCE,SDADTCK S SDADTC=(SDADT\1)-1+.99,SDADTCK=SDADTC+1 F D Q:'SDSCE!(SD6="COE") 75 ..S SDSCE=$$EXAE^SDOE(DFN,SDADTC,SDADTCK) 76 ..I SDSCE>1 N SDDATA D GETGEN^SDOE(SDSCE,"SDDATA") D 77 ...N SDCL0,SDCL1,SDCL2 78 ...S SDCLL=$P(SDDATA(0),"^",4) I $P(^SC(SDCLL,0),"^",17)="Y" D Q 79 ....S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 ; 80 ...S SDCL0=$P(^SC(SDCL,0),"^",7)_$P(^SC(SDCL,0),"^",18) 81 ...S SDCL2=$P(^SC(SDCLL,0),"^",7)_$P(^SC(SDCLL,0),"^",18) 82 ...I SDCL0'=SDCL2 S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 Q 83 ...; proceed if the same DSS IDs pairs 84 ...S SDCO=$P(SDDATA(0),"^",7) 85 ...I SDCO'="" S SD6="COE",SD25="F",SDMSH=$S(SFD=0:"S14",1:"S12") Q 86 ...;encounter exists but not in final (chek out) status 87 ...S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 88 .I SD6="COE" Q 89 .;check out by matching encounter 90 .E I ((TODAY\1)-(SDADT\1))>2 D ;give 2 days to update 91 ..S SD6="NM",SD25="F",SDMSH=$S(SFD=0:"S14",1:0) ;no match, to be skipped 92 Q 0 93 ; 94 SCHEDULE(DFN,SDCL,SDADT) ; Scheduling flag 95 ; If the patient has another appointment created on the same day as the cancellation date of the canceled appt, and that 96 ; appointment is created for a clinic with the same stop code then return "RS". 97 ; If there is not another appointment made on the same day, return "". 98 N SDCDT,SDCLN S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ;cancellation date 99 Q:'SDCDT "" 100 N SDCDTI S SDCDTI=SDCDT\1 101 N SDRESCH S SDRESCH="" 102 ;exclude the same appointments 103 N SDAPDT S SDAPDT="" F S SDAPDT=$O(^DPT("ASADM",SDCDTI,DFN,SDAPDT)) Q:SDAPDT="" I SDAPDT>3030000 I SDAPDT'=SDADT I $D(^DPT(DFN,"S",SDAPDT)) D Q:SDRESCH'="" 104 .S SDCLN=+$P(^DPT(DFN,"S",SDAPDT,0),U) I $P(^SC(SDCLN,0),"^",7)=$P(^SC(SDCL,0),"^",7) S SDRESCH="RS"_"^"_SDAPDT ;compare stop code pointers 105 S:SDRESCH="" SDRESCH="^" Q SDRESCH 1 SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am 2 ;;5.3;Scheduling;**290,333,349,376**;AUG 13, 2003 3 ;Evaluation of the appointment status is done from the computed field to match the displayed/printed status in the appointment management 4 Q 5 ; 6 STATUS(DFN,SDADT,SDCL,TODAY,SFD) ; 7 ;Input: 8 ; SDADT - Appt date/time 9 ; SDCL - Clinic IEN 10 ; SFD: - 0 - if called from scanning previous runs - update 11 ; - 1 - if called from scanning 2.98 12 ;Output: 13 ; SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL_U_SD8RD 14 ; where: 15 ; SDMSH -HL7 segment 16 ; SD25 - Filler Status: 17 ; P - Pending 18 ; F - Final 19 ; SD6 - Event Reason 20 ; SD8 - Appt Type 21 ; SD8RD - rescheduled date/time if SD8="RS" 22 ; SDCO - check out date 23 ; SDCLL - clinic IEN from matching encounter 24 ; 25 N SD0,SDST,SD6,SD8,SD25,SDMSH,SDCO,SDSTAT,SD8S,SD8RD 26 S SDST=$$GET1^DIQ(2.98,SDADT_","_DFN_",",3,"I") 27 I SDST'="" I SDST'="NT"&(SDST'="I") D Q SDSTAT 28 .S SD25="F",SDCO="",SD8RD="" 29 .I SDST="C" S SD6="CC",SD8="",SDMSH="S15" D ;cancel by clinic 30 ..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2) 31 .I SDST="CA" S SD6="CC",SD8="ABK",SDMSH="S15" ;cancel bt clinic and auto rebook 32 .I SDST="PC" S SD6="CP",SD8="",SDMSH="S15" D ; cancel by patient 33 ..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2) 34 .I SDST="PCA" S SD6="CP",SD8="ABK",SDMSH="S15" ;cancel by patient and auto rebook 35 .I SDST="NA" S SD6="NS",SD8="ABK",SDMSH="S26" ;no show and auto rebook 36 .I SDST="N" S SD6="NS",SD8="",SDMSH="S26" ;no show 37 .;evaluate 'non-count' 38 .I $P($G(^SC(SDCL,0)),U,17)="Y" D 39 ..I SD8="" S SD8="NC" Q 40 ..I SD8="RS" S SD8="RSN" 41 .; 42 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 43 ;process all others 44 S SD0=^DPT(DFN,"S",SDADT,0) 45 ; check out from OUTPAT ENCOUNTER 46 ;N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0 S SDCO=$P(^SCE(SCE,0),"^",7) 47 N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0,$D(^SCE(SCE,0)) S SDCO=$P(^SCE(SCE,0),"^",7) 48 N SDSTATX,SDX3 49 S SDSTATX=$$STATUS^SDAM1(DFN,SDADT,SDCL,SD0) ;call to compute the status (VistA) 50 ;SDSTATX=Appt status IFN in 409.63 ; status name ; print status ; check in ; check out 51 I SDCO="" S SDCO=$P(SDSTATX,";",5) ; check out from clinic if NULL 52 I SDCO'=""&(+SDSTATX'=12) D Q SDSTAT 53 .S SD6="CO",SD25="F",SD8="",SD8RD="",SDMSH=$S(SFD=0:"S14",1:"S12") 54 .I +SDSTATX=3 S SD8="AR" ; action required 55 .I +SDSTATX=8 S SD8="I" ;inpatient 56 .;I +SDSTATX=12 S SD8="NC" ;non-count excluded to be compared to possible encounter does not matter if check out 57 .I +SDSTATX=2 S SD8="O" ;outpatient 58 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 59 I +SDSTATX=3 D Q SDSTAT 60 .S SD25="P",SDMSH="S12",SDCO="",SD8RD="" 61 .I $P(SDSTATX,";",4)'="" S SD6="CI",SD8="AR" ;check in/action required 62 .E S SD6="",SD8="NAT",SD8RD="" ;no action taken 63 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 64 I +SDSTATX=8!(+SDSTATX=11) S SD25="P",SD8RD="" D Q SDSTAT 65 .I +SDSTATX=8 S SD6="",SD8="I",SDCO="",SDMSH="S12" ;inpatient 66 .I +SDSTATX=11 S SD6="",SD8="F",SDCO="",SDMSH="S12" ;future 67 .S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD 68 ; 69 ;process non-count (not checked out) 70 I +SDSTATX=12 N SDCLL S SDCLL="" D S:SD6'="COE" SDCLL=SDCL S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL Q SDSTAT 71 .S SD6="",SD8="NC",SDCO="",SDMSH="S12",SD25="P" 72 .I (SDADT\1)-(TODAY\1)>0 S SD6="",SD8="NCF",SD25="P" Q 73 .N SDADTC,SDSCE,SDADTCK S SDADTC=(SDADT\1)-1+.99,SDADTCK=SDADTC+1 F D Q:'SDSCE!(SD6="COE") 74 ..S SDSCE=$$EXAE^SDOE(DFN,SDADTC,SDADTCK) 75 ..I SDSCE>1 N SDDATA D GETGEN^SDOE(SDSCE,"SDDATA") D 76 ...N SDCL0,SDCL1,SDCL2 77 ...S SDCLL=$P(SDDATA(0),"^",4) I $P(^SC(SDCLL,0),"^",17)="Y" D Q 78 ....S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 ; 79 ...S SDCL0=$P(^SC(SDCL,0),"^",7)_$P(^SC(SDCL,0),"^",18) 80 ...S SDCL2=$P(^SC(SDCLL,0),"^",7)_$P(^SC(SDCLL,0),"^",18) 81 ...I SDCL0'=SDCL2 S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 Q 82 ...; proceed if the same DSS IDs pairs 83 ...S SDCO=$P(SDDATA(0),"^",7) 84 ...I SDCO'="" S SD6="COE",SD25="F",SDMSH=$S(SFD=0:"S14",1:"S12") Q 85 ...;encounter exists but not in final (chek out) status 86 ...S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 87 .I SD6="COE" Q 88 .;check out by matching encounter 89 .E I ((TODAY\1)-(SDADT\1))>2 D ;give 2 days to update 90 ..S SD6="NM",SD25="F",SDMSH=$S(SFD=0:"S14",1:0) ;no match, to be skipped 91 Q 0 92 ; 93 SCHEDULE(DFN,SDCL,SDADT) ; Scheduling flag 94 ; If the patient has another appointment created on the same day as the cancellation date of the canceled appt, and that 95 ; appointment is created for a clinic with the same stop code then return "RS". 96 ; If there is not another appointment made on the same day, return "". 97 N SDCDT,SDCLN S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ;cancellation date 98 Q:'SDCDT "" 99 N SDCDTI S SDCDTI=SDCDT\1 100 N SDRESCH S SDRESCH="" 101 ;exclude the same appointments 102 N SDAPDT S SDAPDT="" F S SDAPDT=$O(^DPT("ASADM",SDCDTI,DFN,SDAPDT)) Q:SDAPDT="" I SDAPDT'=SDADT I $D(^DPT(DFN,"S",SDAPDT)) D Q:SDRESCH'="" 103 .S SDCLN=+$P(^DPT(DFN,"S",SDAPDT,0),U) I $P(^SC(SDCLN,0),"^",7)=$P(^SC(SDCL,0),"^",7) S SDRESCH="RS"_"^"_SDAPDT ;compare stop code pointers 104 S:SDRESCH="" SDRESCH="^" Q SDRESCH
Note:
See TracChangeset
for help on using the changeset viewer.
