SDECALVR ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
; Add entries to VISIT related files. from APCDALVAR
;
VPROV(SDEC) ;add provider to V PROVIDER file
;INPUT:
; SDEC("PRO") - provider pointer to NEW PERSON file
; SDEC("PAT") - DFN pointer to PATIENT file
; SDEC("VST") - visit ien pointer to VISIT file
; SDEC("TMP") - (not used) input template "[SDECALVR 9000010.06 (ADD)]"
; SDEC("TPS") - "P"
; SDEC("TOA") - OPERATING/ATTENDING
; SDEC("CDT") - event date and time
;
N SDFDA,SDIEN,SDIENS,SDMSG
N SDCDT,SDCHK,SDPRO,SDTOA,SDTPS,SDVST
N DFN
;validate provider (required)
S SDPRO=$G(SDEC("PRO"))
Q:'+SDPRO
Q:'$D(^VA(200,SDPRO,0))
;validate patient (required)
S DFN=$G(SDEC("PAT"))
Q:'+DFN
Q:'$D(^DPT(DFN,0))
;validate visit (required)
S SDVST=$G(SDEC("VST"))
Q:'+SDVST
Q:'$D(^AUPNVSIT(SDVST,0))
;validate primary/secondary (required)
S SDTPS=$G(SDEC("TPS"))
Q:$S(SDTPS="P":0,SDTPS="S":0,1:1)
;validate operating attending (optional)
S SDTOA=$G(SDEC("TOA"))
S SDTOA=$S(SDTOA="A":"A",SDTOA="ATTENDING":"A",SDTOA="O":"O",SDTOA="OPERATING":"O",1:"")
;validate event date and time
S SDCDT=$G(SDEC("CDT"))
;check for existing entry
S SDCHK=$$VPROVFND(DFN,SDVST,SDPRO)
S SDIENS=$S(+SDCHK:""""_SDCHK_",""",1:"""+1,""")
;
S SDFDA="SDFDA(9000010.06,"_SDIENS_")"
S @SDFDA@(.01)=SDPRO
S @SDFDA@(.02)=DFN
S @SDFDA@(.03)=SDVST
S @SDFDA@(.04)=SDTPS
S:SDTOA'="" @SDFDA@(.05)=SDTOA
S:SDCDT'="" @SDFDA@(1201)=SDCDT
;D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
D UPDATE^DIE("","SDFDA","SDIEN")
;
;I $D(SDMSG) S SDAFLG=2,SDAFLG("ERR")=".01^"_SDPRO_"^V PROVIDER ENTRY FAILED" Q
Q
;
VPROVFND(DFN,SDVST,SDPRO) ;find existing V PROVIDER entry
N SDH1,SDH2,SDH3,SDRET
S SDRET=0
S SDH1="" F S SDH1=$O(^AUPNVPRV("AD",SDVST,SDH1)) Q:SDH1="" D
.S SDH1(SDH1)=""
Q:'$D(SDH1) SDRET
S SDH2="" F S SDH2=$O(^AUPNVPRV("C",DFN,SDH2)) Q:SDH2="" D
.S:$D(SDH1(SDH2)) SDH2(SDH2)="" ;only matching entries will be in SDH2 array
Q:'$D(SDH2) SDRET
S SDH3="" F S SDH3=$O(^AUPNVPRV("B",SDPRO,SDH3)) Q:SDH3="" D
.S:$D(SDH2(SDH3)) SDH3(SDH3)="" ;only matching entries will be in SDH3 array
Q:'$D(SDH3) SDRET
S SDRET=$O(SDH3(9999999),-1)
Q +SDRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECALVR 2311 printed Apr 09, 2024@21:51:02 Page 2
SDECALVR ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
+5 ; Add entries to VISIT related files. from APCDALVAR
+6 ;
VPROV(SDEC) ;add provider to V PROVIDER file
+1 ;INPUT:
+2 ; SDEC("PRO") - provider pointer to NEW PERSON file
+3 ; SDEC("PAT") - DFN pointer to PATIENT file
+4 ; SDEC("VST") - visit ien pointer to VISIT file
+5 ; SDEC("TMP") - (not used) input template "[SDECALVR 9000010.06 (ADD)]"
+6 ; SDEC("TPS") - "P"
+7 ; SDEC("TOA") - OPERATING/ATTENDING
+8 ; SDEC("CDT") - event date and time
+9 ;
+10 NEW SDFDA,SDIEN,SDIENS,SDMSG
+11 NEW SDCDT,SDCHK,SDPRO,SDTOA,SDTPS,SDVST
+12 NEW DFN
+13 ;validate provider (required)
+14 SET SDPRO=$GET(SDEC("PRO"))
+15 if '+SDPRO
QUIT
+16 if '$DATA(^VA(200,SDPRO,0))
QUIT
+17 ;validate patient (required)
+18 SET DFN=$GET(SDEC("PAT"))
+19 if '+DFN
QUIT
+20 if '$DATA(^DPT(DFN,0))
QUIT
+21 ;validate visit (required)
+22 SET SDVST=$GET(SDEC("VST"))
+23 if '+SDVST
QUIT
+24 if '$DATA(^AUPNVSIT(SDVST,0))
QUIT
+25 ;validate primary/secondary (required)
+26 SET SDTPS=$GET(SDEC("TPS"))
+27 if $SELECT(SDTPS="P"
QUIT
+28 ;validate operating attending (optional)
+29 SET SDTOA=$GET(SDEC("TOA"))
+30 SET SDTOA=$SELECT(SDTOA="A":"A",SDTOA="ATTENDING":"A",SDTOA="O":"O",SDTOA="OPERATING":"O",1:"")
+31 ;validate event date and time
+32 SET SDCDT=$GET(SDEC("CDT"))
+33 ;check for existing entry
+34 SET SDCHK=$$VPROVFND(DFN,SDVST,SDPRO)
+35 SET SDIENS=$SELECT(+SDCHK:""""_SDCHK_",""",1:"""+1,""")
+36 ;
+37 SET SDFDA="SDFDA(9000010.06,"_SDIENS_")"
+38 SET @SDFDA@(.01)=SDPRO
+39 SET @SDFDA@(.02)=DFN
+40 SET @SDFDA@(.03)=SDVST
+41 SET @SDFDA@(.04)=SDTPS
+42 if SDTOA'=""
SET @SDFDA@(.05)=SDTOA
+43 if SDCDT'=""
SET @SDFDA@(1201)=SDCDT
+44 ;D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+45 DO UPDATE^DIE("","SDFDA","SDIEN")
+46 ;
+47 ;I $D(SDMSG) S SDAFLG=2,SDAFLG("ERR")=".01^"_SDPRO_"^V PROVIDER ENTRY FAILED" Q
+48 QUIT
+49 ;
VPROVFND(DFN,SDVST,SDPRO) ;find existing V PROVIDER entry
+1 NEW SDH1,SDH2,SDH3,SDRET
+2 SET SDRET=0
+3 SET SDH1=""
FOR
SET SDH1=$ORDER(^AUPNVPRV("AD",SDVST,SDH1))
if SDH1=""
QUIT
Begin DoDot:1
+4 SET SDH1(SDH1)=""
End DoDot:1
+5 if '$DATA(SDH1)
QUIT SDRET
+6 SET SDH2=""
FOR
SET SDH2=$ORDER(^AUPNVPRV("C",DFN,SDH2))
if SDH2=""
QUIT
Begin DoDot:1
+7 ;only matching entries will be in SDH2 array
if $DATA(SDH1(SDH2))
SET SDH2(SDH2)=""
End DoDot:1
+8 if '$DATA(SDH2)
QUIT SDRET
+9 SET SDH3=""
FOR
SET SDH3=$ORDER(^AUPNVPRV("B",SDPRO,SDH3))
if SDH3=""
QUIT
Begin DoDot:1
+10 ;only matching entries will be in SDH3 array
if $DATA(SDH2(SDH3))
SET SDH3(SDH3)=""
End DoDot:1
+11 if '$DATA(SDH3)
QUIT SDRET
+12 SET SDRET=$ORDER(SDH3(9999999),-1)
+13 QUIT +SDRET
