MBAAAPI1 ;OIT-PD/VSL,LAB - SCHEDULING CONSULT API ;06/23/2022
;;1.0;Scheduling Calendar View;**1,12**;Feb 10, 2016;Build 1
;
;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
;GETAPCNS(RETURN,DFN,STPCOD) ; Get active/pending consult requests
;N LST,FLDS,SVS,LST,TT,X1,X2
;S RETURN=0
;S FLDS(.01)="DATE",FLDS(.02)="PATIENT",FLDS(.04)="CLINIC",FLDS(.1)="TEXT"
;S FLDS(8)="STATUS",FLDS(1)="SERVICE",FLDS(10)="SENDER",FLDS(13)="TYPE"
;I STPCOD="" Q 0
;D GETCONSR^MBAADAL1(.LST,.DFN,.FLDS)
;N A,CPRSTAT,DTENTR,DTLMT,NOS,NOSHOW
;K TMP S NOSHOW="no-show",X1=DT,X2=-365 D C^%DTC S DTLMT=X
;S A=":"
;F S A=$O(LST(A),-1) Q:'+A D
;. D GETRQSV^MBAADAL1(.SVS,STPCOD,+LST(A,1)) Q:'+SVS("DILIST",0)
;. S DTENTR=$P(LST(A,.01),U) I DTENTR<DTLMT Q
;. S CPRSTAT=$P(LST(A,8),U) Q:$S(CPRSTAT=5!(CPRSTAT=6)!(CPRSTAT=8)!(CPRSTAT=13):0,1:1)
;. S PTIEN=$P(LST(A,.02),U)
;. I CPRSTAT=8 S STOP=0 D Q:STOP
;. . I $$CONSLNKD^MBAADAL1(A) S STOP=1 Q
;. . S NOS=$O(LST(A,40,":"),-1) I '+NOS S STOP=1 Q
;. . S X2=LST(A,40,NOS,.01),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
;. . D SCHED(PTIEN,STPCOD,.SHOW) I 'SHOW S STOP=1 Q
;. . ;CPRSTAT 13 is a cancel
;. I CPRSTAT=13 S NOS=$O(LST(A,40,":"),-1) Q:'+NOS D
;. . S NOS=$O(LST(A,40,NOS),-1) I '+NOS S STOP=1 Q
;. . S X2=$P(LST(A,40,NOS,.01),U),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
;. . S COMMENT=$G(LST(A,40,NOS,5,1)) I COMMENT'[NOSHOW S STOP=1 Q
;. M TT(A)=LST(A) D BLDCONS(.TT,.RETURN,.FLDS)
;S RETURN=1
;Q 1
;
;SCHED(PTIEN,STPCOD,SHOW) ;===CONSULT IS SCHEDULE NOW CHECK IF IT HAS APPOINTMENT BY STOP CODE.
;N APT,APTS,SD,STOP,CLNC,CLN,STOPCOD
;S %DT="ST",X="T-1" D ^%DT
;S SD=Y,SD(0)=1,STOP=0,APT="",SHOW=1
;D GETAPTS^MBAAMDA2(.APTS,PTIEN,.SD)
;F S APT=$O(APTS("APT",APT)) Q:'+APT!(STOP) D
;. S CLNC=$P(APTS("APT",APT,"CLINIC"),U)
;. Q:CLNC=""
;. D GETCLN^MBAAMDA1(.CLN,CLNC,1)
;. S STOPCOD=$G(CLN(8)) Q:STOPCOD=""
;. I STOPCOD'=STPCOD S SHOW=1 Q
;. D GETCAPT^MBAAMDA4(.CAPT,PTIEN,APT)
;. I $D(CAPT) S SHOW=0,STOP=1
;Q
;
;BLDCONS(CIN,COUT,FLDS) ; Build consult list
;N FLD,NO
;N IN S IN=0
;F S IN=$O(CIN(IN)) Q:'IN D
;. F FLD=0:0 S FLD=$O(FLDS(FLD)) Q:'FLD S COUT(IN,FLDS(FLD))=CIN(IN,FLD)
;. F NO=0:0 S NO=$O(CIN(IN,40,NO)) Q:'NO D
;. . S COUT(IN,"ACT",NO,"DATE")=CIN(IN,40,NO,.01)
;Q
;
CANCEL(RETURN,CONS,SC,SD,IFN,RMK,WHO,ADM,AUTO,CNDIE,CNDA) ; appt was cancelled then mark consult as edit/resubmit, add comment. Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
N CAPT,CNS,CLN,BY,CONSULT,SDPATNT,COMMENT,USER
S:$D(CONS) CONSULT=CONS
S RETURN=0
D GETCAPT^MBAAMDA1(.CAPT,SC,SD,IFN,"I")
I '$D(CONS) S CONSULT=$G(CAPT(688,"I"))
Q:'+CONSULT 0
S SDPATNT=$G(CAPT(.01,"I"))
D GETCONS^MBAADAL1(.CNS,CONSULT,"IE")
S CPRSSTAT=$G(CNS(8,"E")) I CPRSSTAT'="" Q:CPRSSTAT'="SCHEDULED" RETURN
S SNDPRV=$G(CNS(10,"I"))
S USER=$G(CNS(10,"E")),Y=SD
D DD^%DT S APPT=$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_$P(Y,"@",2)
D GETCLN^MBAAMDA1(.CLN,SC,1,1)
S BY=$S($D(WHO):$S(WHO["P":" by the Patient.",WHO["C":" by the Clinic.",1:"."),$D(ADM):" for administrative purposes.",1:", whole clinic.")
S COMMENT(1)=$P(CLN(.01),U)_" Appt. on "_APPT_" was cancelled"_BY
S:$D(RMK) COMMENT(2)="Remarks: "_RMK
;Code removed from initial release of SCV. will be included in next release of SCV.
N SDERR S SDERR=$$STATUS^GMRCGUIS(CONSULT,6,3,SNDPRV,"","",.COMMENT) ;ICR#: 4854 updates the status of a consult
S CNDIE="^GMR(123,"_CONS_",40,",CNDA=+$G(COMMENT(0))
S AUTO(SC,SD,SDPATNT)=CONS
N FLDS S FLDS(688)="@"
D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,IFN)
;Code removed from initial release of SCV. will be included in next release of SCV.
;D STATUS^GMRCGUIS(.FLDS,SC,SD,IFN) ;ICR#: 4854 updates the status of a consult
K APPT,CPRSSTAT,SNDPRV,COMMENT,Y,USER
S RETURN=1
Q 1
;
;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
;AUTOREB(RETURN,SC,SD,LNK,CIFN) ; Auto rebook
;N FLDS,Y,TME,CLN,CNS,SNDPRV,CSCHDT,COMMENT,ER
;N FLDS S FLDS(688)=LNK
;S RETURN=0
;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CIFN)
;S Y=SD D DD^%DT S TME=$P(Y,"@",2)
;D GETCLN^MBAAMDA1(.CLN,SC,1,1)
;S COMMENT(1)=$P(CLN(.01),U)_" Consult Appt. on "_$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_TME_" (Auto Rebooked)."
;S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y
;D GETCONS^MBAADAL1(.CNS,LNK,"IE")
;S SNDPRV=$G(CNS(10,"I"))
;D SCH^SDQQCN2(.ER,LNK,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT
;S RETURN=1
;Q 1
;
;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
;NOSHOW(RETURN,SC,SD,DFN,CONS,CN,AUTO,NSDIE,NSDA) ;
;Appt. was a NoShow, then mark Consult as Edit/Resubmit, add comment using silent call to notify user.
;Variables NSDIE and NSDA used in calling routine for NoShow letter printed comment in consult.
;N CNS,CLN,SRV,CPRSSTAT,SNDPRV,NOSHOW,CSPRT,USER,APPT,COMMENT
;S RETURN=0
;D GETCONS^MBAADAL1(.CNS,CONS,"IE")
;S CPRSSTAT=$G(CNS(8,"E")),SNDPRV=$G(CNS(10,"I"))
;S NOSHOW="no-show",AUTO(SC,SD,DFN)=CONS
;I CPRSSTAT'="" Q:CPRSSTAT'="SCHEDULED" 0
;D GETRQSV1^MBAADAL1(.SRV,$G(CNS(1,"I")),"123.09","IE")
;S:SRV(123.09,"E")'="" CSPRT=$G(SRV(123.09,"E"))
;S USER=$G(CNS(10,"E")),Y=SD
;D DD^%DT S APPT=$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_$P(Y,"@",2)
;D GETCLN^MBAAMDA1(.CLN,SC,1,1)
;S COMMENT(1)=$P(CLN(.01),U)_" Appt. on "_APPT_" was a "_NOSHOW_"." ;no-show is a key word used by a search do not change
;N SDERR S SDERR=$$STATUS^GMRCGUIS(CONS,6,3,SNDPRV,"","",.COMMENT)
;S NSDIE="^GMR(123,"_CONS_",40,",NSDA=+$G(COMMENT(0))
;N FLDS S FLDS(688)="@"
;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CN)
;I $D(CSPRT) D EN^GMRCP5(CONS,"C",CSPRT)
;S RETURN=1
;Q 1
;
EDITCS(RETURN,CONS,SD,RMK,CLNC) ;Mark consult as scheduled Called by RPC MBAA APPOINTMENT MAKE
N CSCHDT,SNDPRV,TME,X,Y,COMMENT,ER,CNS
S RETURN=0
S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y K %DT
D GETCONS^MBAADAL1(.CNS,CONS,"IE")
S SNDPRV=$G(CNS(10,"I")),Y=SD
D DD^%DT S TME=$P($P(Y,"@",2),":",1,2)
S COMMENT(1)=$P(CLNC,U,2)_" Consult Appt. on "_$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_TME
S COMMENT(2)=RMK
D SCH^SDQQCN2(.ER,CONS,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT ;ICR#: 6050 MBAA SDQQCN2 API
S RETURN=1
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAAPI1 6440 printed Oct 16, 2024@18:15:28 Page 2
MBAAAPI1 ;OIT-PD/VSL,LAB - SCHEDULING CONSULT API ;06/23/2022
+1 ;;1.0;Scheduling Calendar View;**1,12**;Feb 10, 2016;Build 1
+2 ;
+3 ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
+4 ;GETAPCNS(RETURN,DFN,STPCOD) ; Get active/pending consult requests
+5 ;N LST,FLDS,SVS,LST,TT,X1,X2
+6 ;S RETURN=0
+7 ;S FLDS(.01)="DATE",FLDS(.02)="PATIENT",FLDS(.04)="CLINIC",FLDS(.1)="TEXT"
+8 ;S FLDS(8)="STATUS",FLDS(1)="SERVICE",FLDS(10)="SENDER",FLDS(13)="TYPE"
+9 ;I STPCOD="" Q 0
+10 ;D GETCONSR^MBAADAL1(.LST,.DFN,.FLDS)
+11 ;N A,CPRSTAT,DTENTR,DTLMT,NOS,NOSHOW
+12 ;K TMP S NOSHOW="no-show",X1=DT,X2=-365 D C^%DTC S DTLMT=X
+13 ;S A=":"
+14 ;F S A=$O(LST(A),-1) Q:'+A D
+15 ;. D GETRQSV^MBAADAL1(.SVS,STPCOD,+LST(A,1)) Q:'+SVS("DILIST",0)
+16 ;. S DTENTR=$P(LST(A,.01),U) I DTENTR<DTLMT Q
+17 ;. S CPRSTAT=$P(LST(A,8),U) Q:$S(CPRSTAT=5!(CPRSTAT=6)!(CPRSTAT=8)!(CPRSTAT=13):0,1:1)
+18 ;. S PTIEN=$P(LST(A,.02),U)
+19 ;. I CPRSTAT=8 S STOP=0 D Q:STOP
+20 ;. . I $$CONSLNKD^MBAADAL1(A) S STOP=1 Q
+21 ;. . S NOS=$O(LST(A,40,":"),-1) I '+NOS S STOP=1 Q
+22 ;. . S X2=LST(A,40,NOS,.01),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
+23 ;. . D SCHED(PTIEN,STPCOD,.SHOW) I 'SHOW S STOP=1 Q
+24 ;. . ;CPRSTAT 13 is a cancel
+25 ;. I CPRSTAT=13 S NOS=$O(LST(A,40,":"),-1) Q:'+NOS D
+26 ;. . S NOS=$O(LST(A,40,NOS),-1) I '+NOS S STOP=1 Q
+27 ;. . S X2=$P(LST(A,40,NOS,.01),U),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
+28 ;. . S COMMENT=$G(LST(A,40,NOS,5,1)) I COMMENT'[NOSHOW S STOP=1 Q
+29 ;. M TT(A)=LST(A) D BLDCONS(.TT,.RETURN,.FLDS)
+30 ;S RETURN=1
+31 ;Q 1
+32 ;
+33 ;SCHED(PTIEN,STPCOD,SHOW) ;===CONSULT IS SCHEDULE NOW CHECK IF IT HAS APPOINTMENT BY STOP CODE.
+34 ;N APT,APTS,SD,STOP,CLNC,CLN,STOPCOD
+35 ;S %DT="ST",X="T-1" D ^%DT
+36 ;S SD=Y,SD(0)=1,STOP=0,APT="",SHOW=1
+37 ;D GETAPTS^MBAAMDA2(.APTS,PTIEN,.SD)
+38 ;F S APT=$O(APTS("APT",APT)) Q:'+APT!(STOP) D
+39 ;. S CLNC=$P(APTS("APT",APT,"CLINIC"),U)
+40 ;. Q:CLNC=""
+41 ;. D GETCLN^MBAAMDA1(.CLN,CLNC,1)
+42 ;. S STOPCOD=$G(CLN(8)) Q:STOPCOD=""
+43 ;. I STOPCOD'=STPCOD S SHOW=1 Q
+44 ;. D GETCAPT^MBAAMDA4(.CAPT,PTIEN,APT)
+45 ;. I $D(CAPT) S SHOW=0,STOP=1
+46 ;Q
+47 ;
+48 ;BLDCONS(CIN,COUT,FLDS) ; Build consult list
+49 ;N FLD,NO
+50 ;N IN S IN=0
+51 ;F S IN=$O(CIN(IN)) Q:'IN D
+52 ;. F FLD=0:0 S FLD=$O(FLDS(FLD)) Q:'FLD S COUT(IN,FLDS(FLD))=CIN(IN,FLD)
+53 ;. F NO=0:0 S NO=$O(CIN(IN,40,NO)) Q:'NO D
+54 ;. . S COUT(IN,"ACT",NO,"DATE")=CIN(IN,40,NO,.01)
+55 ;Q
+56 ;
CANCEL(RETURN,CONS,SC,SD,IFN,RMK,WHO,ADM,AUTO,CNDIE,CNDA) ; appt was cancelled then mark consult as edit/resubmit, add comment. Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW CAPT,CNS,CLN,BY,CONSULT,SDPATNT,COMMENT,USER
+2 if $DATA(CONS)
SET CONSULT=CONS
+3 SET RETURN=0
+4 DO GETCAPT^MBAAMDA1(.CAPT,SC,SD,IFN,"I")
+5 IF '$DATA(CONS)
SET CONSULT=$GET(CAPT(688,"I"))
+6 if '+CONSULT
QUIT 0
+7 SET SDPATNT=$GET(CAPT(.01,"I"))
+8 DO GETCONS^MBAADAL1(.CNS,CONSULT,"IE")
+9 SET CPRSSTAT=$GET(CNS(8,"E"))
IF CPRSSTAT'=""
if CPRSSTAT'="SCHEDULED"
QUIT RETURN
+10 SET SNDPRV=$GET(CNS(10,"I"))
+11 SET USER=$GET(CNS(10,"E"))
SET Y=SD
+12 DO DD^%DT
SET APPT=$EXTRACT(SD,4,5)_"/"_$EXTRACT(SD,6,7)_"/"_$EXTRACT(SD,2,3)_" @ "_$PIECE(Y,"@",2)
+13 DO GETCLN^MBAAMDA1(.CLN,SC,1,1)
+14 SET BY=$SELECT($DATA(WHO):$SELECT(WHO["P":" by the Patient.",WHO["C":" by the Clinic.",1:"."),$DATA(ADM):" for administrative purposes.",1:", whole clinic.")
+15 SET COMMENT(1)=$PIECE(CLN(.01),U)_" Appt. on "_APPT_" was cancelled"_BY
+16 if $DATA(RMK)
SET COMMENT(2)="Remarks: "_RMK
+17 ;Code removed from initial release of SCV. will be included in next release of SCV.
+18 ;ICR#: 4854 updates the status of a consult
NEW SDERR
SET SDERR=$$STATUS^GMRCGUIS(CONSULT,6,3,SNDPRV,"","",.COMMENT)
+19 SET CNDIE="^GMR(123,"_CONS_",40,"
SET CNDA=+$GET(COMMENT(0))
+20 SET AUTO(SC,SD,SDPATNT)=CONS
+21 NEW FLDS
SET FLDS(688)="@"
+22 DO UPDCAPT^MBAAMDA4(.FLDS,SC,SD,IFN)
+23 ;Code removed from initial release of SCV. will be included in next release of SCV.
+24 ;D STATUS^GMRCGUIS(.FLDS,SC,SD,IFN) ;ICR#: 4854 updates the status of a consult
+25 KILL APPT,CPRSSTAT,SNDPRV,COMMENT,Y,USER
+26 SET RETURN=1
+27 QUIT 1
+28 ;
+29 ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
+30 ;AUTOREB(RETURN,SC,SD,LNK,CIFN) ; Auto rebook
+31 ;N FLDS,Y,TME,CLN,CNS,SNDPRV,CSCHDT,COMMENT,ER
+32 ;N FLDS S FLDS(688)=LNK
+33 ;S RETURN=0
+34 ;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CIFN)
+35 ;S Y=SD D DD^%DT S TME=$P(Y,"@",2)
+36 ;D GETCLN^MBAAMDA1(.CLN,SC,1,1)
+37 ;S COMMENT(1)=$P(CLN(.01),U)_" Consult Appt. on "_$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_TME_" (Auto Rebooked)."
+38 ;S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y
+39 ;D GETCONS^MBAADAL1(.CNS,LNK,"IE")
+40 ;S SNDPRV=$G(CNS(10,"I"))
+41 ;D SCH^SDQQCN2(.ER,LNK,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT
+42 ;S RETURN=1
+43 ;Q 1
+44 ;
+45 ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
+46 ;NOSHOW(RETURN,SC,SD,DFN,CONS,CN,AUTO,NSDIE,NSDA) ;
+47 ;Appt. was a NoShow, then mark Consult as Edit/Resubmit, add comment using silent call to notify user.
+48 ;Variables NSDIE and NSDA used in calling routine for NoShow letter printed comment in consult.
+49 ;N CNS,CLN,SRV,CPRSSTAT,SNDPRV,NOSHOW,CSPRT,USER,APPT,COMMENT
+50 ;S RETURN=0
+51 ;D GETCONS^MBAADAL1(.CNS,CONS,"IE")
+52 ;S CPRSSTAT=$G(CNS(8,"E")),SNDPRV=$G(CNS(10,"I"))
+53 ;S NOSHOW="no-show",AUTO(SC,SD,DFN)=CONS
+54 ;I CPRSSTAT'="" Q:CPRSSTAT'="SCHEDULED" 0
+55 ;D GETRQSV1^MBAADAL1(.SRV,$G(CNS(1,"I")),"123.09","IE")
+56 ;S:SRV(123.09,"E")'="" CSPRT=$G(SRV(123.09,"E"))
+57 ;S USER=$G(CNS(10,"E")),Y=SD
+58 ;D DD^%DT S APPT=$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_$P(Y,"@",2)
+59 ;D GETCLN^MBAAMDA1(.CLN,SC,1,1)
+60 ;S COMMENT(1)=$P(CLN(.01),U)_" Appt. on "_APPT_" was a "_NOSHOW_"." ;no-show is a key word used by a search do not change
+61 ;N SDERR S SDERR=$$STATUS^GMRCGUIS(CONS,6,3,SNDPRV,"","",.COMMENT)
+62 ;S NSDIE="^GMR(123,"_CONS_",40,",NSDA=+$G(COMMENT(0))
+63 ;N FLDS S FLDS(688)="@"
+64 ;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CN)
+65 ;I $D(CSPRT) D EN^GMRCP5(CONS,"C",CSPRT)
+66 ;S RETURN=1
+67 ;Q 1
+68 ;
EDITCS(RETURN,CONS,SD,RMK,CLNC) ;Mark consult as scheduled Called by RPC MBAA APPOINTMENT MAKE
+1 NEW CSCHDT,SNDPRV,TME,X,Y,COMMENT,ER,CNS
+2 SET RETURN=0
+3 SET %DT="ST"
SET X="NOW"
DO ^%DT
SET CSCHDT=Y
KILL %DT
+4 DO GETCONS^MBAADAL1(.CNS,CONS,"IE")
+5 SET SNDPRV=$GET(CNS(10,"I"))
SET Y=SD
+6 DO DD^%DT
SET TME=$PIECE($PIECE(Y,"@",2),":",1,2)
+7 SET COMMENT(1)=$PIECE(CLNC,U,2)_" Consult Appt. on "_$EXTRACT(SD,4,5)_"/"_$EXTRACT(SD,6,7)_"/"_$EXTRACT(SD,2,3)_" @ "_TME
+8 SET COMMENT(2)=RMK
+9 ;ICR#: 6050 MBAA SDQQCN2 API
DO SCH^SDQQCN2(.ER,CONS,SNDPRV,CSCHDT,0,,.COMMENT)
KILL COMMENT
+10 SET RETURN=1
+11 QUIT 1
+12 ;
