MBAADAL1 ;OIT-PD/CBR - CONSULT DAL ;02/10/2016
;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
;Associated ICRs
; ICR#
; 6052 GMR(123
;
;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
;GETCONSR(RETURN,DFN,FLDS) ; Get consult requests
; N FILE,FIELDS,RET,SCR,LST,SFLS,DL,IN
; S FILE=123,FIELDS=".01IE;.02IE;.04IE;.1;8IE;1IE"
; S SCR="I $P(^(0),U,2)=$G(DFN)"
; D LIST^DIC(FILE,"",FIELDS,"",,,,"F",.SCR,"","LST","ERR")
; S IN="",DL="DILIST"
; S SFLS("40")="",SFLS("40","N")="COMM",SFLS("40","F")="123.02"
; F S IN=$O(LST(DL,2,IN)) Q:IN="" D
; . N CR
; . D GETREC^MBAAMDAL(.CR,LST(DL,2,IN),123,.FLDS,.SFLS,1,1)
; . M RETURN(LST(DL,2,IN))=CR
; Q
;
;GETRQSV(RETURN,STPCOD,SRV) ; Get request service
; N SCR,ERR
; S SCR="I $D(^GMR(123.5,""AB1"","_STPCOD_","_SRV_"))"
; D LIST^DIC(123.5,"","","",,,,"AB1",.SCR,"","RETURN","ERR")
; Q
; ;
;GETRQSV1(RETURN,SRV,FLDS,FLAG) ; Get request service by IFN
; N DA,DIQ,DIC,DR,GMR
; S DIQ="GMR(",DIC="^GMR(123.5,",DIQ(0)=$G(FLAG)
; S DA=SRV,DR=FLDS
; D EN^DIQ1
; M RETURN=GMR(123.5,SRV)
; Q
;
GETCONS(RETURN,CONS,FLAG) ; Get consult Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
N DA,DIQ,DIC,DR,GMR
S DIQ="GMR(",DIC="^GMR(123,",DIQ(0)=$G(FLAG) ;ICR#: 6052 GMR(123
S DA=CONS,DR=".001:70"
D EN^DIQ1
M RETURN=GMR(123,CONS)
Q
;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
;CONSLNKD(CONS) ; Return 1 if consult is already linked
; Q:'$D(CONS) 0
; Q $D(^SC("AWAS1",CONS))
; ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAADAL1 1690 printed Nov 22, 2024@17:24:51 Page 2
MBAADAL1 ;OIT-PD/CBR - CONSULT DAL ;02/10/2016
+1 ;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
+2 ;Associated ICRs
+3 ; ICR#
+4 ; 6052 GMR(123
+5 ;
+6 ;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
+7 ;GETCONSR(RETURN,DFN,FLDS) ; Get consult requests
+8 ; N FILE,FIELDS,RET,SCR,LST,SFLS,DL,IN
+9 ; S FILE=123,FIELDS=".01IE;.02IE;.04IE;.1;8IE;1IE"
+10 ; S SCR="I $P(^(0),U,2)=$G(DFN)"
+11 ; D LIST^DIC(FILE,"",FIELDS,"",,,,"F",.SCR,"","LST","ERR")
+12 ; S IN="",DL="DILIST"
+13 ; S SFLS("40")="",SFLS("40","N")="COMM",SFLS("40","F")="123.02"
+14 ; F S IN=$O(LST(DL,2,IN)) Q:IN="" D
+15 ; . N CR
+16 ; . D GETREC^MBAAMDAL(.CR,LST(DL,2,IN),123,.FLDS,.SFLS,1,1)
+17 ; . M RETURN(LST(DL,2,IN))=CR
+18 ; Q
+19 ;
+20 ;GETRQSV(RETURN,STPCOD,SRV) ; Get request service
+21 ; N SCR,ERR
+22 ; S SCR="I $D(^GMR(123.5,""AB1"","_STPCOD_","_SRV_"))"
+23 ; D LIST^DIC(123.5,"","","",,,,"AB1",.SCR,"","RETURN","ERR")
+24 ; Q
+25 ; ;
+26 ;GETRQSV1(RETURN,SRV,FLDS,FLAG) ; Get request service by IFN
+27 ; N DA,DIQ,DIC,DR,GMR
+28 ; S DIQ="GMR(",DIC="^GMR(123.5,",DIQ(0)=$G(FLAG)
+29 ; S DA=SRV,DR=FLDS
+30 ; D EN^DIQ1
+31 ; M RETURN=GMR(123.5,SRV)
+32 ; Q
+33 ;
GETCONS(RETURN,CONS,FLAG) ; Get consult Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW DA,DIQ,DIC,DR,GMR
+2 ;ICR#: 6052 GMR(123
SET DIQ="GMR("
SET DIC="^GMR(123,"
SET DIQ(0)=$GET(FLAG)
+3 SET DA=CONS
SET DR=".001:70"
+4 DO EN^DIQ1
+5 MERGE RETURN=GMR(123,CONS)
+6 QUIT
+7 ;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
+8 ;CONSLNKD(CONS) ; Return 1 if consult is already linked
+9 ; Q:'$D(CONS) 0
+10 ; Q $D(^SC("AWAS1",CONS))
+11 ; ;
