SDES2GETCLINAVL ;ALB/BWF - SDES2 GET CLINIC AVAIL BY SVC; MAY 24,2024
;;5.3;Scheduling;**880,887**;Aug 13, 1993;Build 7
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; INPUT
;
; SDCONTEXT - STANDARD SDCONTEXT ARRAY
;
; SDINPUT("PRIMARY AMIS")=PRIMARY AMIS CODE
; SDINPUT("CREDIT AMIS",CREDIT AMIS CODE)="" - can have multiple credit amis codes
; SDINPUT("START DATE")=START DATE
; SDINPUT("END DATE")=ENDDATE
; SDINPUT("NUMBER RETURNED")=NUMBER OF AVAILABLE SLOTS TO RETURN
; SDINPUT("STATION")=STATION NUMBER FOR LOCATION
;
CLINICAVAIL(RESULT,SDCONTEXT,SDINPUT) ;
N CLINLIST,ERRORS,CLINAVAIL,STARTDTFM,ENDDTFM,PRIMARYSTOP,SECSTOPLIST,NUMBERRET,RESULTDATA
K ^TMP("SDES2CLINAVAIL",$J)
S RESULT=$NA(^TMP("SDES2CLINAVAIL",$J,"JSON"))
S RESULTDATA=$NA(^TMP("SDES2CLINAVAIL",$J,"DATA"))
S CLINLIST=$NA(^TMP("SDES2CLINAVAIL",$J,"CLINLIST"))
D VALIDATE(.ERRORS,.SDINPUT,.STARTDTFM,.ENDDTFM,.NUMBERRET)
I $D(ERRORS) D Q
.S ERRORS("ClinicAvailability",1)=""
.D ENCODE^XLFJSON("ERRORS",.RESULT)
D MATCHCLIN(.CLINLIST,$G(SDINPUT("PRIMARY AMIS")),.SDINPUT)
D GETAVAIL(.RESULTDATA,.CLINLIST,STARTDTFM,ENDDTFM,$G(SDINPUT("STATION")),NUMBERRET)
I '$D(@RESULTDATA) S @RESULTDATA@("ClinicAvailability",1)=""
D ENCODE^XLFJSON(.RESULTDATA,.RESULT)
K ^TMP("SDES2CLINAVAIL",$J,"CLINLIST"),^TMP("SDES2CLINAVAIL",$J,"DATA")
Q
VALIDATE(ERRORS,SDINPUT,STARTDTFM,ENDDTFM,NUMBERRET) ;
N ERRORNUM,PRIMAMIS,STARTDT,ENDDT,DATERESULT,INST
; Validate Station Number
I $G(SDINPUT("STATION"))="" D ERRLOG^SDES2JSON(.ERRORS,196)
I $G(SDINPUT("STATION"))'="" D
.S INST=$$IEN^XUAF4($G(SDINPUT("STATION")))
.I 'INST D ERRLOG^SDES2JSON(.ERRORS,197)
; Validate Primary Amis
S PRIMAMIS=$G(SDINPUT("PRIMARY AMIS"))
I PRIMAMIS D
.S ERRORNUM=$$VALIDATEAMIS^SDES2UTIL($G(SDINPUT("PRIMARY AMIS")),"P")
.I ERRORNUM D ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,PRIMAMIS) Q
I 'PRIMAMIS D ERRLOG^SDES2JSON(.ERRORS,479)
; Validate secondary Amis
I $D(SDINPUT("CREDIT AMIS")) D VALCRSTOP(.ERRORS,.SDINPUT)
;
; Validate start/end dates
S DATERESULT=$$VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$G(SDINPUT("START DATE")),$G(SDINPUT("END DATE")),1)
I '$D(ERRORS) S STARTDTFM=$P(DATERESULT,U),ENDDTFM=$P(DATERESULT,U,2)
; Validate number returned
I '$D(SDINPUT("NUMBER RETURNED")) S NUMBERRET=500
I $D(SDINPUT("NUMBER RETURNED")) S NUMBERRET=$G(SDINPUT("NUMBER RETURNED"))
D VALNUM(.ERRORS,NUMBERRET)
Q
GETAVAIL(RETURN,CLINLIST,START,END,STATION,NUMBER) ;
N CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,AVAILDATE,SDECEND,BADATE,LOOP
N PROV,PRVCNT,DEFAULTPROVIDER,APPTSTRTDTTM,TOTALAVAILCNT,APPTENDDTTM
S (CNT,DONE)=0
S CLIN="" F S CLIN=$O(@CLINLIST@(CLIN),-1) Q:'CLIN!(DONE) D
.S GLOB=$NA(^TMP("SDES2CLINAVAIL",$J,"CLINSCHED",CLIN)) K @GLOB
.S BADATE=0
.S AVAILDATE=$$FMADD^XLFDT(START,-1),SDECEND=END
.F S AVAILDATE=$$FMADD^XLFDT(AVAILDATE,1) Q:AVAILDATE>$P(SDECEND,".",1)!(BADATE>0)!(DONE) D ;
..I AVAILDATE<0 S BADATE=1 Q
..I ($O(^SC(CLIN,"T",0))="")!($O(^SC(CLIN,"T",0))>AVAILDATE) Q
..I $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",AVAILDATE)) Q ;do not schedule on holidays
..Q:$$INACTIVE^SDESUTIL(CLIN,$P(AVAILDATE,".",1)) ;don't get availability if clinic inactive on day AVAILDATE
..D RESAB^SDEC57(GLOB,CLIN,AVAILDATE,AVAILDATE_"."_2359) Q:'$D(^TMP("SDES2CLINAVAIL",$J,"CLINSCHED",CLIN))
..S LOOP=0 F S LOOP=$O(^TMP("SDES2CLINAVAIL",$J,"CLINSCHED",CLIN,LOOP)) Q:'LOOP!(DONE) D
...S APPTDAT=$G(^TMP("SDES2CLINAVAIL",$J,"CLINSCHED",CLIN,LOOP))
...S APPTSTRT=$P(APPTDAT,U,2)
...S APPTEND=$P(APPTDAT,U,3)
...S SLOTS=$P(APPTDAT,U,4)
...Q:SLOTS=0!(SLOTS="")
...S AVAIL=$P(APPTDAT,U,5)
...S SLOTS=$S(SLOTS=" ":"",1:SLOTS)
...S SLOTS=$S(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
...I "jklmnopqrstuvwxyz"[SLOTS S SLOTS=9+($F("jklmnopqrstuvwxyz",SLOTS)-1)
...Q:'SLOTS
...S ^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRT,CLIN)=APPTEND_U_SLOTS
.K @GLOB
S (TOTALAVAILCNT,DONE,CNT)=0
S APPTSTRTDTTM=0 F S APPTSTRTDTTM=$O(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM)) Q:'APPTSTRTDTTM!(DONE) D
.S CLIN=0 F S CLIN=$O(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM,CLIN)) Q:'CLIN!(DONE) D
..S AVAIL=$G(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM,CLIN))
..S APPTENDDTTM=$P(AVAIL,U,1),SLOTS=$P(AVAIL,U,2)
..;S TOTALAVAILCNT=TOTALAVAILCNT+SLOTS
..S CNT=CNT+1
..S @RETURN@("ClinicAvailability",CNT,"ClinicID")=CLIN
..S @RETURN@("ClinicAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
..S @RETURN@("ClinicAvailability",CNT,"Visn")=$S($G(STATION)]"":$$VISN($G(SDINPUT("STATION"))),1:"")
..S @RETURN@("ClinicAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT(APPTSTRTDTTM)
..S @RETURN@("ClinicAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT(APPTENDDTTM)
..S @RETURN@("ClinicAvailability",CNT,"AvailableSlots")=SLOTS
..S (PROV,PRVCNT)=0 F S PROV=$O(^SC(CLIN,"PR",PROV)) Q:'PROV D
...S PRVCNT=PRVCNT+1
...S @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderName")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"E")
...S @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderId")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"I")
...S DEFAULTPROVIDER=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.02,"I")
...S DEFAULTPROVIDER=$S(DEFAULTPROVIDER'="":DEFAULTPROVIDER,1:0)
...S @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"DefaultProvider")=DEFAULTPROVIDER
..S @RETURN@("ClinicAvailability",CNT,"ClinicTimeZone")=$P($$TIMEZONEDATA^SDESUTIL(CLIN),"^",1)
..I CNT>=NUMBER S DONE=1 Q
K ^TMP("SDES2CLINAVAIL",$J,"DATE")
Q
MATCHCLIN(CLINLIST,STCODE,SDINPUT) ;
N STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN,STATION
S STATION=$G(SDINPUT("STATION"))
S STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
S CRSTLOOP=0 F S CRSTLOOP=$O(SDINPUT("CREDIT AMIS",CRSTLOOP)) Q:'CRSTLOOP D
.S CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTLOOP)
.I CREDSTOPIEN S CREDSTOPIENS(CREDSTOPIEN)=""
S CLINIEN=0 F S CLINIEN=$O(^SC("AST",STOPIEN,CLINIEN)) Q:'CLINIEN D
.I STATION]"",STATION'=$$STATIONNUMBER^SDES2UTIL(CLINIEN) Q
.I $D(CREDSTOPIENS) D Q
..S CRSTOPIEN=0 F S CRSTOPIEN=$O(CREDSTOPIENS(CRSTOPIEN)) Q:'CRSTOPIEN D
...I $D(^SC("ACST",CRSTOPIEN,CLINIEN)) S @CLINLIST@(CLINIEN)="" Q
.S @CLINLIST@(CLINIEN)=""
Q
VALCRSTOP(ERRORS,SDINPUT) ;
N SECAMIS,ERRORNUM
S SECAMIS=0 F S SECAMIS=$O(SDINPUT("CREDIT AMIS",SECAMIS)) Q:SECAMIS="" D
.S ERRORNUM=$$VALIDATEAMIS^SDES2UTIL(SECAMIS,"C")
.I ERRORNUM D ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,SECAMIS)
Q
VALNUM(ERRORS,NUMBERRET) ;
I $G(NUMBERRET)<1!($G(NUMBERRET)>500) D ERRLOG^SDESJSON(.ERRORS,52,"Number of records to return must be between 1 and 500.")
Q
VISN(INSTNUM) ;
N IEN,VISNPTR,VISN
S VISN=0
S IEN=$$IEN^XUAF4(INSTNUM)
S:$G(IEN)>0 VISNPTR=$$GET1^DIQ(4.014,"1,"_IEN_",",1,"I")
I $G(VISNPTR)>0 D
.S VISN=$$GET1^DIQ(4,VISNPTR,.01,"I")
.S VISN=$P(VISN," ",2)
Q VISN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETCLINAVL 6979 printed Oct 16, 2024@18:54:26 Page 2
SDES2GETCLINAVL ;ALB/BWF - SDES2 GET CLINIC AVAIL BY SVC; MAY 24,2024
+1 ;;5.3;Scheduling;**880,887**;Aug 13, 1993;Build 7
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; INPUT
+6 ;
+7 ; SDCONTEXT - STANDARD SDCONTEXT ARRAY
+8 ;
+9 ; SDINPUT("PRIMARY AMIS")=PRIMARY AMIS CODE
+10 ; SDINPUT("CREDIT AMIS",CREDIT AMIS CODE)="" - can have multiple credit amis codes
+11 ; SDINPUT("START DATE")=START DATE
+12 ; SDINPUT("END DATE")=ENDDATE
+13 ; SDINPUT("NUMBER RETURNED")=NUMBER OF AVAILABLE SLOTS TO RETURN
+14 ; SDINPUT("STATION")=STATION NUMBER FOR LOCATION
+15 ;
CLINICAVAIL(RESULT,SDCONTEXT,SDINPUT) ;
+1 NEW CLINLIST,ERRORS,CLINAVAIL,STARTDTFM,ENDDTFM,PRIMARYSTOP,SECSTOPLIST,NUMBERRET,RESULTDATA
+2 KILL ^TMP("SDES2CLINAVAIL",$JOB)
+3 SET RESULT=$NAME(^TMP("SDES2CLINAVAIL",$JOB,"JSON"))
+4 SET RESULTDATA=$NAME(^TMP("SDES2CLINAVAIL",$JOB,"DATA"))
+5 SET CLINLIST=$NAME(^TMP("SDES2CLINAVAIL",$JOB,"CLINLIST"))
+6 DO VALIDATE(.ERRORS,.SDINPUT,.STARTDTFM,.ENDDTFM,.NUMBERRET)
+7 IF $DATA(ERRORS)
Begin DoDot:1
+8 SET ERRORS("ClinicAvailability",1)=""
+9 DO ENCODE^XLFJSON("ERRORS",.RESULT)
End DoDot:1
QUIT
+10 DO MATCHCLIN(.CLINLIST,$GET(SDINPUT("PRIMARY AMIS")),.SDINPUT)
+11 DO GETAVAIL(.RESULTDATA,.CLINLIST,STARTDTFM,ENDDTFM,$GET(SDINPUT("STATION")),NUMBERRET)
+12 IF '$DATA(@RESULTDATA)
SET @RESULTDATA@("ClinicAvailability",1)=""
+13 DO ENCODE^XLFJSON(.RESULTDATA,.RESULT)
+14 KILL ^TMP("SDES2CLINAVAIL",$JOB,"CLINLIST"),^TMP("SDES2CLINAVAIL",$JOB,"DATA")
+15 QUIT
VALIDATE(ERRORS,SDINPUT,STARTDTFM,ENDDTFM,NUMBERRET) ;
+1 NEW ERRORNUM,PRIMAMIS,STARTDT,ENDDT,DATERESULT,INST
+2 ; Validate Station Number
+3 IF $GET(SDINPUT("STATION"))=""
DO ERRLOG^SDES2JSON(.ERRORS,196)
+4 IF $GET(SDINPUT("STATION"))'=""
Begin DoDot:1
+5 SET INST=$$IEN^XUAF4($GET(SDINPUT("STATION")))
+6 IF 'INST
DO ERRLOG^SDES2JSON(.ERRORS,197)
End DoDot:1
+7 ; Validate Primary Amis
+8 SET PRIMAMIS=$GET(SDINPUT("PRIMARY AMIS"))
+9 IF PRIMAMIS
Begin DoDot:1
+10 SET ERRORNUM=$$VALIDATEAMIS^SDES2UTIL($GET(SDINPUT("PRIMARY AMIS")),"P")
+11 IF ERRORNUM
DO ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,PRIMAMIS)
QUIT
End DoDot:1
+12 IF 'PRIMAMIS
DO ERRLOG^SDES2JSON(.ERRORS,479)
+13 ; Validate secondary Amis
+14 IF $DATA(SDINPUT("CREDIT AMIS"))
DO VALCRSTOP(.ERRORS,.SDINPUT)
+15 ;
+16 ; Validate start/end dates
+17 SET DATERESULT=$$VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$GET(SDINPUT("START DATE")),$GET(SDINPUT("END DATE")),1)
+18 IF '$DATA(ERRORS)
SET STARTDTFM=$PIECE(DATERESULT,U)
SET ENDDTFM=$PIECE(DATERESULT,U,2)
+19 ; Validate number returned
+20 IF '$DATA(SDINPUT("NUMBER RETURNED"))
SET NUMBERRET=500
+21 IF $DATA(SDINPUT("NUMBER RETURNED"))
SET NUMBERRET=$GET(SDINPUT("NUMBER RETURNED"))
+22 DO VALNUM(.ERRORS,NUMBERRET)
+23 QUIT
GETAVAIL(RETURN,CLINLIST,START,END,STATION,NUMBER) ;
+1 NEW CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,AVAILDATE,SDECEND,BADATE,LOOP
+2 NEW PROV,PRVCNT,DEFAULTPROVIDER,APPTSTRTDTTM,TOTALAVAILCNT,APPTENDDTTM
+3 SET (CNT,DONE)=0
+4 SET CLIN=""
FOR
SET CLIN=$ORDER(@CLINLIST@(CLIN),-1)
if 'CLIN!(DONE)
QUIT
Begin DoDot:1
+5 SET GLOB=$NAME(^TMP("SDES2CLINAVAIL",$JOB,"CLINSCHED",CLIN))
KILL @GLOB
+6 SET BADATE=0
+7 SET AVAILDATE=$$FMADD^XLFDT(START,-1)
SET SDECEND=END
+8 ;
FOR
SET AVAILDATE=$$FMADD^XLFDT(AVAILDATE,1)
if AVAILDATE>$PIECE(SDECEND,".",1)!(BADATE>0)!(DONE)
QUIT
Begin DoDot:2
+9 IF AVAILDATE<0
SET BADATE=1
QUIT
+10 IF ($ORDER(^SC(CLIN,"T",0))="")!($ORDER(^SC(CLIN,"T",0))>AVAILDATE)
QUIT
+11 ;do not schedule on holidays
IF $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y"
IF $DATA(^HOLIDAY("B",AVAILDATE))
QUIT
+12 ;don't get availability if clinic inactive on day AVAILDATE
if $$INACTIVE^SDESUTIL(CLIN,$PIECE(AVAILDATE,".",1))
QUIT
+13 DO RESAB^SDEC57(GLOB,CLIN,AVAILDATE,AVAILDATE_"."_2359)
if '$DATA(^TMP("SDES2CLINAVAIL",$JOB,"CLINSCHED",CLIN))
QUIT
+14 SET LOOP=0
FOR
SET LOOP=$ORDER(^TMP("SDES2CLINAVAIL",$JOB,"CLINSCHED",CLIN,LOOP))
if 'LOOP!(DONE)
QUIT
Begin DoDot:3
+15 SET APPTDAT=$GET(^TMP("SDES2CLINAVAIL",$JOB,"CLINSCHED",CLIN,LOOP))
+16 SET APPTSTRT=$PIECE(APPTDAT,U,2)
+17 SET APPTEND=$PIECE(APPTDAT,U,3)
+18 SET SLOTS=$PIECE(APPTDAT,U,4)
+19 if SLOTS=0!(SLOTS="")
QUIT
+20 SET AVAIL=$PIECE(APPTDAT,U,5)
+21 SET SLOTS=$SELECT(SLOTS=" ":"",1:SLOTS)
+22 SET SLOTS=$SELECT(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
+23 IF "jklmnopqrstuvwxyz"[SLOTS
SET SLOTS=9+($FIND("jklmnopqrstuvwxyz",SLOTS)-1)
+24 if 'SLOTS
QUIT
+25 SET ^TMP("SDES2CLINAVAIL",$JOB,"DATE",APPTSTRT,CLIN)=APPTEND_U_SLOTS
End DoDot:3
End DoDot:2
+26 KILL @GLOB
End DoDot:1
+27 SET (TOTALAVAILCNT,DONE,CNT)=0
+28 SET APPTSTRTDTTM=0
FOR
SET APPTSTRTDTTM=$ORDER(^TMP("SDES2CLINAVAIL",$JOB,"DATE",APPTSTRTDTTM))
if 'APPTSTRTDTTM!(DONE)
QUIT
Begin DoDot:1
+29 SET CLIN=0
FOR
SET CLIN=$ORDER(^TMP("SDES2CLINAVAIL",$JOB,"DATE",APPTSTRTDTTM,CLIN))
if 'CLIN!(DONE)
QUIT
Begin DoDot:2
+30 SET AVAIL=$GET(^TMP("SDES2CLINAVAIL",$JOB,"DATE",APPTSTRTDTTM,CLIN))
+31 SET APPTENDDTTM=$PIECE(AVAIL,U,1)
SET SLOTS=$PIECE(AVAIL,U,2)
+32 ;S TOTALAVAILCNT=TOTALAVAILCNT+SLOTS
+33 SET CNT=CNT+1
+34 SET @RETURN@("ClinicAvailability",CNT,"ClinicID")=CLIN
+35 SET @RETURN@("ClinicAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
+36 SET @RETURN@("ClinicAvailability",CNT,"Visn")=$SELECT($GET(STATION)]"":$$VISN($GET(SDINPUT("STATION"))),1:"")
+37 SET @RETURN@("ClinicAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT(APPTSTRTDTTM)
+38 SET @RETURN@("ClinicAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT(APPTENDDTTM)
+39 SET @RETURN@("ClinicAvailability",CNT,"AvailableSlots")=SLOTS
+40 SET (PROV,PRVCNT)=0
FOR
SET PROV=$ORDER(^SC(CLIN,"PR",PROV))
if 'PROV
QUIT
Begin DoDot:3
+41 SET PRVCNT=PRVCNT+1
+42 SET @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderName")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"E")
+43 SET @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderId")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"I")
+44 SET DEFAULTPROVIDER=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.02,"I")
+45 SET DEFAULTPROVIDER=$SELECT(DEFAULTPROVIDER'="":DEFAULTPROVIDER,1:0)
+46 SET @RETURN@("ClinicAvailability",CNT,"Provider",PRVCNT,"DefaultProvider")=DEFAULTPROVIDER
End DoDot:3
+47 SET @RETURN@("ClinicAvailability",CNT,"ClinicTimeZone")=$PIECE($$TIMEZONEDATA^SDESUTIL(CLIN),"^",1)
+48 IF CNT>=NUMBER
SET DONE=1
QUIT
End DoDot:2
End DoDot:1
+49 KILL ^TMP("SDES2CLINAVAIL",$JOB,"DATE")
+50 QUIT
MATCHCLIN(CLINLIST,STCODE,SDINPUT) ;
+1 NEW STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN,STATION
+2 SET STATION=$GET(SDINPUT("STATION"))
+3 SET STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
+4 SET CRSTLOOP=0
FOR
SET CRSTLOOP=$ORDER(SDINPUT("CREDIT AMIS",CRSTLOOP))
if 'CRSTLOOP
QUIT
Begin DoDot:1
+5 SET CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTLOOP)
+6 IF CREDSTOPIEN
SET CREDSTOPIENS(CREDSTOPIEN)=""
End DoDot:1
+7 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(^SC("AST",STOPIEN,CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:1
+8 IF STATION]""
IF STATION'=$$STATIONNUMBER^SDES2UTIL(CLINIEN)
QUIT
+9 IF $DATA(CREDSTOPIENS)
Begin DoDot:2
+10 SET CRSTOPIEN=0
FOR
SET CRSTOPIEN=$ORDER(CREDSTOPIENS(CRSTOPIEN))
if 'CRSTOPIEN
QUIT
Begin DoDot:3
+11 IF $DATA(^SC("ACST",CRSTOPIEN,CLINIEN))
SET @CLINLIST@(CLINIEN)=""
QUIT
End DoDot:3
End DoDot:2
QUIT
+12 SET @CLINLIST@(CLINIEN)=""
End DoDot:1
+13 QUIT
VALCRSTOP(ERRORS,SDINPUT) ;
+1 NEW SECAMIS,ERRORNUM
+2 SET SECAMIS=0
FOR
SET SECAMIS=$ORDER(SDINPUT("CREDIT AMIS",SECAMIS))
if SECAMIS=""
QUIT
Begin DoDot:1
+3 SET ERRORNUM=$$VALIDATEAMIS^SDES2UTIL(SECAMIS,"C")
+4 IF ERRORNUM
DO ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,SECAMIS)
End DoDot:1
+5 QUIT
VALNUM(ERRORS,NUMBERRET) ;
+1 IF $GET(NUMBERRET)<1!($GET(NUMBERRET)>500)
DO ERRLOG^SDESJSON(.ERRORS,52,"Number of records to return must be between 1 and 500.")
+2 QUIT
VISN(INSTNUM) ;
+1 NEW IEN,VISNPTR,VISN
+2 SET VISN=0
+3 SET IEN=$$IEN^XUAF4(INSTNUM)
+4 if $GET(IEN)>0
SET VISNPTR=$$GET1^DIQ(4.014,"1,"_IEN_",",1,"I")
+5 IF $GET(VISNPTR)>0
Begin DoDot:1
+6 SET VISN=$$GET1^DIQ(4,VISNPTR,.01,"I")
+7 SET VISN=$PIECE(VISN," ",2)
End DoDot:1
+8 QUIT VISN
