Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MBAAAPI1

MBAAAPI1.m

Go to the documentation of this file. 
  1. MBAAAPI1 ;OIT-PD/VSL,LAB - SCHEDULING CONSULT API ;06/23/2022
  1.  ;;1.0;Scheduling Calendar View;**1,12**;Feb 10, 2016;Build 1
  1.  ;
  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
  1.  ;GETAPCNS(RETURN,DFN,STPCOD) ; Get active/pending consult requests
  1.  ;N LST,FLDS,SVS,LST,TT,X1,X2
  1.  ;S RETURN=0
  1.  ;S FLDS(.01)="DATE",FLDS(.02)="PATIENT",FLDS(.04)="CLINIC",FLDS(.1)="TEXT"
  1.  ;S FLDS(8)="STATUS",FLDS(1)="SERVICE",FLDS(10)="SENDER",FLDS(13)="TYPE"
  1.  ;I STPCOD="" Q 0
  1.  ;D GETCONSR^MBAADAL1(.LST,.DFN,.FLDS)
  1.  ;N A,CPRSTAT,DTENTR,DTLMT,NOS,NOSHOW
  1.  ;K TMP S NOSHOW="no-show",X1=DT,X2=-365 D C^%DTC S DTLMT=X
  1.  ;S A=":"
  1.  ;F  S A=$O(LST(A),-1) Q:'+A  D
  1.  ;. D GETRQSV^MBAADAL1(.SVS,STPCOD,+LST(A,1)) Q:'+SVS("DILIST",0)
  1.  ;. S DTENTR=$P(LST(A,.01),U) I DTENTR<DTLMT Q
  1.  ;. S CPRSTAT=$P(LST(A,8),U) Q:$S(CPRSTAT=5!(CPRSTAT=6)!(CPRSTAT=8)!(CPRSTAT=13):0,1:1)
  1.  ;. S PTIEN=$P(LST(A,.02),U)
  1.  ;. I CPRSTAT=8 S STOP=0 D  Q:STOP
  1.  ;. . I $$CONSLNKD^MBAADAL1(A) S STOP=1 Q
  1.  ;. . S NOS=$O(LST(A,40,":"),-1) I '+NOS S STOP=1 Q
  1.  ;. . S X2=LST(A,40,NOS,.01),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
  1.  ;. . D SCHED(PTIEN,STPCOD,.SHOW) I 'SHOW S STOP=1 Q
  1.  ;. . ;CPRSTAT 13 is a cancel
  1.  ;. I CPRSTAT=13 S NOS=$O(LST(A,40,":"),-1) Q:'+NOS  D
  1.  ;. . S NOS=$O(LST(A,40,NOS),-1) I '+NOS S STOP=1 Q
  1.  ;. . S X2=$P(LST(A,40,NOS,.01),U),X1=DT D ^%DTC I X'=""&(X>180) S STOP=1 Q
  1.  ;. . S COMMENT=$G(LST(A,40,NOS,5,1)) I COMMENT'[NOSHOW S STOP=1 Q
  1.  ;. M TT(A)=LST(A) D BLDCONS(.TT,.RETURN,.FLDS)
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  1.  ;SCHED(PTIEN,STPCOD,SHOW) ;===CONSULT IS SCHEDULE NOW CHECK IF IT HAS APPOINTMENT BY STOP CODE.
  1.  ;N APT,APTS,SD,STOP,CLNC,CLN,STOPCOD
  1.  ;S %DT="ST",X="T-1" D ^%DT
  1.  ;S SD=Y,SD(0)=1,STOP=0,APT="",SHOW=1
  1.  ;D GETAPTS^MBAAMDA2(.APTS,PTIEN,.SD)
  1.  ;F  S APT=$O(APTS("APT",APT)) Q:'+APT!(STOP)  D
  1.  ;. S CLNC=$P(APTS("APT",APT,"CLINIC"),U)
  1.  ;. Q:CLNC=""
  1.  ;. D GETCLN^MBAAMDA1(.CLN,CLNC,1)
  1.  ;. S STOPCOD=$G(CLN(8)) Q:STOPCOD=""
  1.  ;. I STOPCOD'=STPCOD S SHOW=1 Q
  1.  ;. D GETCAPT^MBAAMDA4(.CAPT,PTIEN,APT)
  1.  ;. I $D(CAPT) S SHOW=0,STOP=1
  1.  ;Q
  1.  ;
  1.  ;BLDCONS(CIN,COUT,FLDS) ; Build consult list
  1.  ;N FLD,NO
  1.  ;N IN S IN=0
  1.  ;F  S IN=$O(CIN(IN)) Q:'IN  D
  1.  ;. F FLD=0:0 S FLD=$O(FLDS(FLD)) Q:'FLD  S COUT(IN,FLDS(FLD))=CIN(IN,FLD)
  1.  ;. F NO=0:0 S NO=$O(CIN(IN,40,NO)) Q:'NO  D
  1.  ;. . S COUT(IN,"ACT",NO,"DATE")=CIN(IN,40,NO,.01)
  1.  ;Q
  1.  ;
  1. 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.  N CAPT,CNS,CLN,BY,CONSULT,SDPATNT,COMMENT,USER
  1.  S:$D(CONS) CONSULT=CONS
  1.  S RETURN=0
  1.  D GETCAPT^MBAAMDA1(.CAPT,SC,SD,IFN,"I")
  1.  I '$D(CONS) S CONSULT=$G(CAPT(688,"I"))
  1.  Q:'+CONSULT 0
  1.  S SDPATNT=$G(CAPT(.01,"I"))
  1.  D GETCONS^MBAADAL1(.CNS,CONSULT,"IE")
  1.  S CPRSSTAT=$G(CNS(8,"E")) I CPRSSTAT'="" Q:CPRSSTAT'="SCHEDULED" RETURN
  1.  S SNDPRV=$G(CNS(10,"I"))
  1.  S USER=$G(CNS(10,"E")),Y=SD
  1.  D DD^%DT S APPT=$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_$P(Y,"@",2)
  1.  D GETCLN^MBAAMDA1(.CLN,SC,1,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.")
  1.  S COMMENT(1)=$P(CLN(.01),U)_" Appt. on "_APPT_" was cancelled"_BY
  1.  S:$D(RMK) COMMENT(2)="Remarks: "_RMK
  1.  ;Code removed from initial release of SCV. will be included in next release of SCV.
  1.  N SDERR S SDERR=$$STATUS^GMRCGUIS(CONSULT,6,3,SNDPRV,"","",.COMMENT)  ;ICR#: 4854 updates the status of a consult
  1.  S CNDIE="^GMR(123,"_CONS_",40,",CNDA=+$G(COMMENT(0))
  1.  S AUTO(SC,SD,SDPATNT)=CONS
  1.  N FLDS S FLDS(688)="@"
  1.  D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,IFN)
  1.  ;Code removed from initial release of SCV. will be included in next release of SCV.
  1.  ;D STATUS^GMRCGUIS(.FLDS,SC,SD,IFN)  ;ICR#: 4854 updates the status of a consult
  1.  K APPT,CPRSSTAT,SNDPRV,COMMENT,Y,USER
  1.  S RETURN=1
  1.  Q 1
  1.  ;
  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
  1.  ;AUTOREB(RETURN,SC,SD,LNK,CIFN) ; Auto rebook
  1.  ;N FLDS,Y,TME,CLN,CNS,SNDPRV,CSCHDT,COMMENT,ER
  1.  ;N FLDS S FLDS(688)=LNK
  1.  ;S RETURN=0
  1.  ;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CIFN)
  1.  ;S Y=SD D DD^%DT S TME=$P(Y,"@",2)
  1.  ;D GETCLN^MBAAMDA1(.CLN,SC,1,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)."
  1.  ;S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y
  1.  ;D GETCONS^MBAADAL1(.CNS,LNK,"IE")
  1.  ;S SNDPRV=$G(CNS(10,"I"))
  1.  ;D SCH^SDQQCN2(.ER,LNK,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  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
  1.  ;NOSHOW(RETURN,SC,SD,DFN,CONS,CN,AUTO,NSDIE,NSDA) ;
  1.  ;Appt. was a NoShow, then mark Consult as Edit/Resubmit, add comment using silent call to notify user.
  1.  ;Variables NSDIE and NSDA used in calling routine for NoShow letter printed comment in consult.
  1.  ;N CNS,CLN,SRV,CPRSSTAT,SNDPRV,NOSHOW,CSPRT,USER,APPT,COMMENT
  1.  ;S RETURN=0
  1.  ;D GETCONS^MBAADAL1(.CNS,CONS,"IE")
  1.  ;S CPRSSTAT=$G(CNS(8,"E")),SNDPRV=$G(CNS(10,"I"))
  1.  ;S NOSHOW="no-show",AUTO(SC,SD,DFN)=CONS
  1.  ;I CPRSSTAT'="" Q:CPRSSTAT'="SCHEDULED" 0
  1.  ;D GETRQSV1^MBAADAL1(.SRV,$G(CNS(1,"I")),"123.09","IE")
  1.  ;S:SRV(123.09,"E")'="" CSPRT=$G(SRV(123.09,"E"))
  1.  ;S USER=$G(CNS(10,"E")),Y=SD
  1.  ;D DD^%DT S APPT=$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_$P(Y,"@",2)
  1.  ;D GETCLN^MBAAMDA1(.CLN,SC,1,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
  1.  ;N SDERR S SDERR=$$STATUS^GMRCGUIS(CONS,6,3,SNDPRV,"","",.COMMENT)
  1.  ;S NSDIE="^GMR(123,"_CONS_",40,",NSDA=+$G(COMMENT(0))
  1.  ;N FLDS S FLDS(688)="@"
  1.  ;D UPDCAPT^MBAAMDA4(.FLDS,SC,SD,CN)
  1.  ;I $D(CSPRT) D EN^GMRCP5(CONS,"C",CSPRT)
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  1. EDITCS(RETURN,CONS,SD,RMK,CLNC) ;Mark consult as scheduled Called by RPC MBAA APPOINTMENT MAKE
  1.  N CSCHDT,SNDPRV,TME,X,Y,COMMENT,ER,CNS
  1.  S RETURN=0
  1.  S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y K %DT
  1.  D GETCONS^MBAADAL1(.CNS,CONS,"IE")
  1.  S SNDPRV=$G(CNS(10,"I")),Y=SD
  1.  D DD^%DT S TME=$P($P(Y,"@",2),":",1,2)
  1.  S COMMENT(1)=$P(CLNC,U,2)_" Consult Appt. on "_$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_TME
  1.  S COMMENT(2)=RMK
  1.  D SCH^SDQQCN2(.ER,CONS,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT  ;ICR#: 6050 MBAA SDQQCN2 API
  1.  S RETURN=1
  1.  Q 1
  1.  ;