SDEC34 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
Q
;
RBERR ;
;Called from RBCLIN on error to set up header
K ^TMP("SDEC",$J)
S ^TMP("SDEC",$J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
S ^TMP("SDEC",$J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
D ERR(999)
Q
;
CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return recordset of CANCELLED patient appointments
;CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
;Return recordset of CANCELLED patient appointments
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;Used in generating cancellation letters for a clinic
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
;RETURN:
; Global Array in which each array entry contains the following cancelled appointment data separated by ^:
; 1. Name
; 2. DOB
; 3. Sex
; 4. HRN
; 5. NewApptDate
; 6. Clinic
; 7. TypeStatus
; 8. RESOURCEID
; 9. APPT_MADE_BY
;10. DATE_APPT_MADE
;11. NOTE
;12. STREET
;13. CITY
;14. STATE
;15. ZIP
;16. HOMEPHONE
;17. OldApptDate
N SDECCAN
S SDECCAN=1
D REBKCLIN(.SDECY,SDECCLST,SDECBEG,SDECEND)
;
Q
;
REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return recordset of rebooked patient appointments between given dates
;REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
;Return recordset of rebooked patient appointments
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;Used in generating rebook letters for a clinic
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
;Called by SDEC REBOOK CLINIC LIST and SDEC CANCEL CLINIC LIST via entry point CANCLIN above
;
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
N %DT,X,Y,SDECJ,SDECCID,SDECCLN,SDECSTRT,SDECAID,SDECNOD,SDECLIST,SDEC,BSDY
;Convert beginning and ending dates
;
;
; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
;
;S X=SDECBEG,%DT="XT" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999"
;I Y=-1 D RBERR(1) Q
S SDECBEG=$$NETTOFM^SDECDATE(SDECBEG,"Y"),SDECBEG=$P(Y,".") ;
I SDECBEG=-1 D RBERR(1) Q ;
S SDECBEG=$P(SDECBEG,".",1),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999" ;
;S X=SDECEND,%DT="XT" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999"
;I Y=-1 D RBERR(1) Q
S SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y") ;
I SDECEND=-1 D RBERR(1) Q ;
S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999" ;
I SDECCLST="" D RBERR(1) Q
;
;
;If SDECCLST is a list of resource NAMES, look up each name and convert to IEN
F SDECJ=1:1:$L(SDECCLST,"|")-1 S SDEC=$P(SDECCLST,"|",SDECJ) D S $P(SDECCLST,"|",SDECJ)=BSDY
. S BSDY=""
. I SDEC]"",$D(^SDEC(409.831,SDEC,0)) S BSDY=SDEC Q
. I SDEC]"",$D(^SDEC(409.831,"B",SDEC)) S BSDY=$O(^SDEC(409.831,"B",SDEC,0)) Q
. Q
;
;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
;
S SDECLIST=""
F SDECJ=1:1:$L(SDECCLST,"|")-1 S SDECCID=$P(SDECCLST,"|",SDECJ) D:+SDECCID
. S SDECCLN=$G(^SDEC(409.831,SDECCID,0)) S SDECCLN=$P(SDECCLN,U) Q:SDECCLN=""
. S SDECSTRT=SDECBEG F S SDECSTRT=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT)) Q:'+SDECSTRT Q:SDECSTRT>SDECEND D
. . S SDECAID=0 F S SDECAID=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID)) Q:'+SDECAID D
. . . S SDECNOD=$G(^SDEC(409.84,SDECAID,0))
. . . I $D(SDECCAN) D Q
. . . . I $P(SDECNOD,U,12) S SDECLIST=SDECLIST_SDECAID_"|" ;Cancelled appt
. . . I $P(SDECNOD,U,11) S SDECLIST=SDECLIST_SDECAID_"|" ;Rebooked appt
D REBKLIST(.SDECY,SDECLIST)
Q
;
REBKLIST(SDECY,SDECLIST) ;patient appointments used in listing REBOOKED appointments for a list of appointmentIDs.
;REBKLIST(SDECY,SDECLIST) external parameter tag is in SDEC
;SDECLIST - pipe |-delimited list of SDEC APPOINTMENT iens (the last |-piece is null)
;
N SDECI,SDECIEN,SDECNOD,SDECCNID,SDECCNOD,SDECMADE,SDECCLRK,SDECNOT,SDECQ,SDEC
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
S ^TMP("SDEC",$J,SDECI)=^(SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
;
;Iterate through SDECLIST
S SDECIEN=0
F SDEC=1:1:$L(SDECLIST,"|")-1 S SDECIEN=$P(SDECLIST,"|",SDEC) D
. N SDECNOD,SDECAPT,SDECCID,SDECCNOD,SDECCLN,SDEC44,SDECDNOD,SDECSTAT,SDEC,SDECTYPE,SDECLIN,SDECPAT
. N SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
. N SDECNAM,SDECDOB,SDECHRN,SDECSEX
. N SDECREBK
. S SDECNOD=$G(^SDEC(409.84,SDECIEN,0))
. Q:SDECNOD=""
. S SDECPAT=$P(SDECNOD,U,5) ;PATIENT ien
. Q:'+SDECPAT
. Q:'$D(^DPT(SDECPAT))
. D PINFO(SDECPAT)
. S Y=$P(SDECNOD,U)
. Q:'+Y
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. S SDECAPT=$$FMTONET^SDECDATE(Y,"Y") ;Appointment date time
. ;X ^DD("DD") S Y=$TR(Y,"@"," ")
. ;S SDECAPT=Y ;Appointment date time
. S SDECREBK=""
. S Y=$P(SDECNOD,U,11)
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. I +Y S SDECREBK=$$FMTONET^SDECDATE(Y,"Y") ; Rebook date time
. ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S SDECREBK=Y ;Rebook date time
. S SDECCLRK=$P(SDECNOD,U,8) ;Appointment made by
. S:+SDECCLRK SDECCLRK=$G(^VA(200,SDECCLRK,0)),SDECCLRK=$P(SDECCLRK,U)
. S Y=$P(SDECNOD,U,9) ;Date Appointment Made
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. I +Y S Y=$$FMTONET^SDECDATE(Y,"Y") ;
. ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. S SDECMADE=Y
. ;NOTE
. S SDECNOT=""
. I $D(^SDEC(409.84,SDECIEN,1,0)) S SDECNOT="",SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECIEN,1,SDECQ)) Q:'+SDECQ D
. . S SDECLIN=$G(^SDEC(409.84,SDECIEN,1,SDECQ,0))
. . S:(SDECLIN'="")&($E(SDECLIN,$L(SDECLIN)-1,$L(SDECLIN))'=" ") SDECLIN=SDECLIN_" "
. . S SDECNOT=SDECNOT_SDECLIN
. ;Resource
. S SDECCID=$P(SDECNOD,U,7) ;IEN of SDEC RESOURCE
. Q:'+SDECCID
. Q:'$D(^SDEC(409.831,SDECCID,0))
. S SDECCNOD=$G(^SDEC(409.831,SDECCID,0)) ;SDEC RESOURCE node
. Q:SDECCNOD=""
. S SDECCLN=$P(SDECCNOD,U) ;Text name of SDEC Resource
. S SDECTYPE="" ;Unused in this recordset
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECREBK_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_SDECAPT_$C(30)
. Q
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
PINFO(SDECPAT) ;
;Get patient info
N SDECNOD
S SDECNOD=$$PATINFO^SDEC27(SDECPAT)
S SDECNAM=$P(SDECNOD,U) ;NAME
S SDECSEX=$P(SDECNOD,U,2) ;SEX
S SDECDOB=$P(SDECNOD,U,3) ;DOB
S SDECHRN=$P(SDECNOD,U,4) ;Health Record Number for location DUZ(2)
S SDECSTRE=$P(SDECNOD,U,5) ;Street
S SDECCITY=$P(SDECNOD,U,6) ;City
S SDECST=$P(SDECNOD,U,7) ;State
S SDECZIP=$P(SDECNOD,U,8) ;zip
S SDECPHON=$P(SDECNOD,U,9) ;homephone
Q
;
ERROR ;
D ERR("VistA Error")
Q
;
ERR(ERRNO) ;Error processing
S:'$D(SDECI) SDECI=999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="^^^^^^^^^^^^^^^^"_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC34 7691 printed Dec 13, 2024@02:50:29 Page 2
SDEC34 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 QUIT
+4 ;
RBERR ;
+1 ;Called from RBCLIN on error to set up header
+2 KILL ^TMP("SDEC",$JOB)
+3 SET ^TMP("SDEC",$JOB,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
+4 SET ^TMP("SDEC",$JOB,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$CHAR(30)
+5 DO ERR(999)
+6 QUIT
+7 ;
CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return recordset of CANCELLED patient appointments
+1 ;CLINCAN(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
+2 ;Return recordset of CANCELLED patient appointments
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;Used in generating cancellation letters for a clinic
+5 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+6 ;SDECBEG and SDECEND are in external date form.
+7 ;RETURN:
+8 ; Global Array in which each array entry contains the following cancelled appointment data separated by ^:
+9 ; 1. Name
+10 ; 2. DOB
+11 ; 3. Sex
+12 ; 4. HRN
+13 ; 5. NewApptDate
+14 ; 6. Clinic
+15 ; 7. TypeStatus
+16 ; 8. RESOURCEID
+17 ; 9. APPT_MADE_BY
+18 ;10. DATE_APPT_MADE
+19 ;11. NOTE
+20 ;12. STREET
+21 ;13. CITY
+22 ;14. STATE
+23 ;15. ZIP
+24 ;16. HOMEPHONE
+25 ;17. OldApptDate
+26 NEW SDECCAN
+27 SET SDECCAN=1
+28 DO REBKCLIN(.SDECY,SDECCLST,SDECBEG,SDECEND)
+29 ;
+30 QUIT
+31 ;
REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return recordset of rebooked patient appointments between given dates
+1 ;REBKCLIN(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
+2 ;Return recordset of rebooked patient appointments
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;Used in generating rebook letters for a clinic
+5 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+6 ;SDECBEG and SDECEND are in external date form.
+7 ;Called by SDEC REBOOK CLINIC LIST and SDEC CANCEL CLINIC LIST via entry point CANCLIN above
+8 ;
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 KILL @SDECY
+11 NEW %DT,X,Y,SDECJ,SDECCID,SDECCLN,SDECSTRT,SDECAID,SDECNOD,SDECLIST,SDEC,BSDY
+12 ;Convert beginning and ending dates
+13 ;
+14 ;
+15 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+16 ;
+17 ;S X=SDECBEG,%DT="XT" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999"
+18 ;I Y=-1 D RBERR(1) Q
+19 ;
SET SDECBEG=$$NETTOFM^SDECDATE(SDECBEG,"Y")
SET SDECBEG=$PIECE(Y,".")
+20 ;
IF SDECBEG=-1
DO RBERR(1)
QUIT
+21 ;
SET SDECBEG=$PIECE(SDECBEG,".",1)
SET SDECBEG=SDECBEG-1
SET SDECBEG=SDECBEG_".9999"
+22 ;S X=SDECEND,%DT="XT" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999"
+23 ;I Y=-1 D RBERR(1) Q
+24 ;
SET SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y")
+25 ;
IF SDECEND=-1
DO RBERR(1)
QUIT
+26 ;
SET SDECEND=$PIECE(Y,".")
SET SDECEND=SDECEND_".9999"
+27 IF SDECCLST=""
DO RBERR(1)
QUIT
+28 ;
+29 ;
+30 ;If SDECCLST is a list of resource NAMES, look up each name and convert to IEN
+31 FOR SDECJ=1:1:$LENGTH(SDECCLST,"|")-1
SET SDEC=$PIECE(SDECCLST,"|",SDECJ)
Begin DoDot:1
+32 SET BSDY=""
+33 IF SDEC]""
IF $DATA(^SDEC(409.831,SDEC,0))
SET BSDY=SDEC
QUIT
+34 IF SDEC]""
IF $DATA(^SDEC(409.831,"B",SDEC))
SET BSDY=$ORDER(^SDEC(409.831,"B",SDEC,0))
QUIT
+35 QUIT
End DoDot:1
SET $PIECE(SDECCLST,"|",SDECJ)=BSDY
+36 ;
+37 ;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
+38 ;
+39 SET SDECLIST=""
+40 FOR SDECJ=1:1:$LENGTH(SDECCLST,"|")-1
SET SDECCID=$PIECE(SDECCLST,"|",SDECJ)
if +SDECCID
Begin DoDot:1
+41 SET SDECCLN=$GET(^SDEC(409.831,SDECCID,0))
SET SDECCLN=$PIECE(SDECCLN,U)
if SDECCLN=""
QUIT
+42 SET SDECSTRT=SDECBEG
FOR
SET SDECSTRT=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT))
if '+SDECSTRT
QUIT
if SDECSTRT>SDECEND
QUIT
Begin DoDot:2
+43 SET SDECAID=0
FOR
SET SDECAID=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID))
if '+SDECAID
QUIT
Begin DoDot:3
+44 SET SDECNOD=$GET(^SDEC(409.84,SDECAID,0))
+45 IF $DATA(SDECCAN)
Begin DoDot:4
+46 ;Cancelled appt
IF $PIECE(SDECNOD,U,12)
SET SDECLIST=SDECLIST_SDECAID_"|"
End DoDot:4
QUIT
+47 ;Rebooked appt
IF $PIECE(SDECNOD,U,11)
SET SDECLIST=SDECLIST_SDECAID_"|"
End DoDot:3
End DoDot:2
End DoDot:1
+48 DO REBKLIST(.SDECY,SDECLIST)
+49 QUIT
+50 ;
REBKLIST(SDECY,SDECLIST) ;patient appointments used in listing REBOOKED appointments for a list of appointmentIDs.
+1 ;REBKLIST(SDECY,SDECLIST) external parameter tag is in SDEC
+2 ;SDECLIST - pipe |-delimited list of SDEC APPOINTMENT iens (the last |-piece is null)
+3 ;
+4 NEW SDECI,SDECIEN,SDECNOD,SDECCNID,SDECCNOD,SDECMADE,SDECCLRK,SDECNOT,SDECQ,SDEC
+5 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+6 KILL @SDECY
+7 SET SDECI=0
+8 SET ^TMP("SDEC",$JOB,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
+9 SET ^TMP("SDEC",$JOB,SDECI)=^(SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$CHAR(30)
+10 ;
+11 ;Iterate through SDECLIST
+12 SET SDECIEN=0
+13 FOR SDEC=1:1:$LENGTH(SDECLIST,"|")-1
SET SDECIEN=$PIECE(SDECLIST,"|",SDEC)
Begin DoDot:1
+14 NEW SDECNOD,SDECAPT,SDECCID,SDECCNOD,SDECCLN,SDEC44,SDECDNOD,SDECSTAT,SDEC,SDECTYPE,SDECLIN,SDECPAT
+15 NEW SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
+16 NEW SDECNAM,SDECDOB,SDECHRN,SDECSEX
+17 NEW SDECREBK
+18 SET SDECNOD=$GET(^SDEC(409.84,SDECIEN,0))
+19 if SDECNOD=""
QUIT
+20 ;PATIENT ien
SET SDECPAT=$PIECE(SDECNOD,U,5)
+21 if '+SDECPAT
QUIT
+22 if '$DATA(^DPT(SDECPAT))
QUIT
+23 DO PINFO(SDECPAT)
+24 SET Y=$PIECE(SDECNOD,U)
+25 if '+Y
QUIT
+26 ;
+27 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+28 ;
+29 ;Appointment date time
SET SDECAPT=$$FMTONET^SDECDATE(Y,"Y")
+30 ;X ^DD("DD") S Y=$TR(Y,"@"," ")
+31 ;S SDECAPT=Y ;Appointment date time
+32 SET SDECREBK=""
+33 SET Y=$PIECE(SDECNOD,U,11)
+34 ;
+35 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+36 ;
+37 ; Rebook date time
IF +Y
SET SDECREBK=$$FMTONET^SDECDATE(Y,"Y")
+38 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S SDECREBK=Y ;Rebook date time
+39 ;Appointment made by
SET SDECCLRK=$PIECE(SDECNOD,U,8)
+40 if +SDECCLRK
SET SDECCLRK=$GET(^VA(200,SDECCLRK,0))
SET SDECCLRK=$PIECE(SDECCLRK,U)
+41 ;Date Appointment Made
SET Y=$PIECE(SDECNOD,U,9)
+42 ;
+43 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+44 ;
+45 ;
IF +Y
SET Y=$$FMTONET^SDECDATE(Y,"Y")
+46 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
+47 SET SDECMADE=Y
+48 ;NOTE
+49 SET SDECNOT=""
+50 IF $DATA(^SDEC(409.84,SDECIEN,1,0))
SET SDECNOT=""
SET SDECQ=0
FOR
SET SDECQ=$ORDER(^SDEC(409.84,SDECIEN,1,SDECQ))
if '+SDECQ
QUIT
Begin DoDot:2
+51 SET SDECLIN=$GET(^SDEC(409.84,SDECIEN,1,SDECQ,0))
+52 if (SDECLIN'="")&($EXTRACT(SDECLIN,$LENGTH(SDECLIN)-1,$LENGTH(SDECLIN))'=" ")
SET SDECLIN=SDECLIN_" "
+53 SET SDECNOT=SDECNOT_SDECLIN
End DoDot:2
+54 ;Resource
+55 ;IEN of SDEC RESOURCE
SET SDECCID=$PIECE(SDECNOD,U,7)
+56 if '+SDECCID
QUIT
+57 if '$DATA(^SDEC(409.831,SDECCID,0))
QUIT
+58 ;SDEC RESOURCE node
SET SDECCNOD=$GET(^SDEC(409.831,SDECCID,0))
+59 if SDECCNOD=""
QUIT
+60 ;Text name of SDEC Resource
SET SDECCLN=$PIECE(SDECCNOD,U)
+61 ;Unused in this recordset
SET SDECTYPE=""
+62 SET SDECI=SDECI+1
+63 SET ^TMP("SDEC",$JOB,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECREBK_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_SDECAPT_$C
HAR(30)
+64 QUIT
End DoDot:1
+65 ;
+66 SET SDECI=SDECI+1
+67 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+68 QUIT
+69 ;
PINFO(SDECPAT) ;
+1 ;Get patient info
+2 NEW SDECNOD
+3 SET SDECNOD=$$PATINFO^SDEC27(SDECPAT)
+4 ;NAME
SET SDECNAM=$PIECE(SDECNOD,U)
+5 ;SEX
SET SDECSEX=$PIECE(SDECNOD,U,2)
+6 ;DOB
SET SDECDOB=$PIECE(SDECNOD,U,3)
+7 ;Health Record Number for location DUZ(2)
SET SDECHRN=$PIECE(SDECNOD,U,4)
+8 ;Street
SET SDECSTRE=$PIECE(SDECNOD,U,5)
+9 ;City
SET SDECCITY=$PIECE(SDECNOD,U,6)
+10 ;State
SET SDECST=$PIECE(SDECNOD,U,7)
+11 ;zip
SET SDECZIP=$PIECE(SDECNOD,U,8)
+12 ;homephone
SET SDECPHON=$PIECE(SDECNOD,U,9)
+13 QUIT
+14 ;
ERROR ;
+1 DO ERR("VistA Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 if '$DATA(SDECI)
SET SDECI=999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)="^^^^^^^^^^^^^^^^"_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
