SDECSTSR ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM
;;5.3;Scheduling;**737**;;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
; Report and fix appointment-encounter-appointment status triples from, respectively, the patient file (#2), the encounter file (#409.68) and
; the appointment file (#409.84).
;
; Distinguish encounter status from before and after installation of patch 722 - 9/11/2019
;
; ICR
; ---
; 7030 - #2 patient appointment data
;
DOWNLOAD ;
;
; Generate summary of appointment-encounter-appointment triples in comma-delimited format that can be uploaded to Excel.
;
; NOTE: This download is an analysis tool run by programmers. It is not linked to an option.
;
W !!,"Generate summary of patient appointment-encounter-appointment file status triples in comma delimited format",! ;
;
N TYPE S TYPE="DOWNLOAD" G SUMMARY1 ;
;
SUMMARY ;
;
; Generate summary of appointment-encounter-appointment triples in report format.
;
; NOTE: This report is an analysis tool run by programmers. It is not linked to an option.
;
W !!,"Generate summary of patient appointment-encounter-appointment file status triples in report format",! ;
;
N TYPE S TYPE="REPORT" ;
;
SUMMARY1 ;
;
N %DT,START,Y,NAME,DFN,DTTM,PTDATA,PTSTATUS,ENCOUNTER,ENCDATA,ENCSTATUS,APPTDATA,APPTSTATUS,FOUND,I ;
N PATCH,ENCDATE,LASTDATE ;
;
; Determine date that patch 722 was installed.
;
S PATCH=$$PATCH(722) ;
;
; Do not look at encounters that are less than a week old.
;
S LASTDATE=$P($$FMADD^XLFDT($$NOW^XLFDT(),-7),".",1) ;
;
; Scan is in date order starting with the user indicated date.
;
W !,"Select appointment starting date",! ;
S %DT="AX" D ^%DT Q:Y<0 S START=$P(Y,".",1) W ! ;
;
K ^TMP($J) ;
;
; Scan patient file in alphabetic order. Process patients that have appointments after the selected start date.
;
S NAME="" F I=1:1 S NAME=$O(^DPT("B",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN W:I#1000=0 "." I $O(^DPT(DFN,"S",START))>0 D ;
. ;
. ; Scan patient's appointments.
. ;
. S DTTM=START F S DTTM=$O(^DPT(DFN,"S",DTTM)) Q:'DTTM Q:DTTM>LASTDATE S PTDATA=^(DTTM,0) D ; ICR #7030
.. ;
.. ; Get status of appointment in patient file.
.. ;
.. S PTSTATUS=$S($P(PTDATA,U,2)'="":$$SETCODES(2.98,3,$P(PTDATA,U,2)),1:"null") ; ICR #7030
.. ;
.. ; Get encounter from patient's appointment record and the status of the encounter from file.
.. ;
.. S ENCOUNTER=$P(PTDATA,U,20),ENCSTATUS=$S(ENCOUNTER:$P($G(^SCE(ENCOUNTER,0)),U,12),1:""),ENCSTATUS=$S(ENCOUNTER="":"NONE",ENCSTATUS="":"null",1:$$GET1^DIQ(409.63,ENCSTATUS_",",.01)) ;
.. ;
.. ; Flag encounter status as BEFORE or AFTER patch 722 installation.
.. ;
.. I ENCSTATUS'="NONE" S ENCDATE=$P($G(^SCE(ENCOUNTER,"USER")),U,4),ENCSTATUS=ENCSTATUS_"-"_$S(ENCDATE="":"NO DATE",ENCDATE<PATCH:"BEFORE",1:"AFTER") ;
.. ;
.. ; Scan appointments in the appointment time for the date/time of the appointment in the patient file.
.. ;
.. S DA=0,FOUND=0 F S DA=$O(^SDEC(409.84,"APTDT",DFN,DTTM,DA)) Q:'DA S APPTDATA=$G(^SDEC(409.84,DA,0)) I APPTDATA'="" S FOUND=1 D ;
... ;
... ; Get status of appointments in appointment file. Update count of triple.
... ;
... S APPTSTATUS=$S($P(APPTDATA,U,17)'="":$$SETCODES(409.84,.17,$P(APPTDATA,U,17)),1:"null") ;
... S ^(APPTSTATUS)=$G(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS))+1 ;
.. ;
.. ; If no matching appointments (FOUND=0), update count for "status" of NONE.
.. ;
.. I 'FOUND S ^("NONE")=$G(^TMP($J,PTSTATUS,ENCSTATUS,"NONE"))+1 ;
;
; If download selected, output results in comma-delimited format
;
I TYPE="DOWNLOAD" D ;
. W !,$C(34),"PATIENT"_$C(34),",",$C(34),"ENCOUNTER",$C(34),",",$C(34),"APPOINTMENT",$C(34),",",$C(34)_"COUNT",$C(34),! ;
. S PTSTATUS="" F S PTSTATUS=$O(^TMP($J,PTSTATUS)) Q:PTSTATUS="" D ;
.. S ENCSTATUS="" F S ENCSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS)) Q:ENCSTATUS="" D ;
... S APPTSTATUS="" F S APPTSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS)) Q:APPTSTATUS="" W $C(34),PTSTATUS,$C(34),",",$C(34),ENCSTATUS,$C(34),",",$C(34),APPTSTATUS,$C(34),",",^(APPTSTATUS),! ;
. ;
;
; If report selected, output formatted report.
;
I TYPE="REPORT" D ;
. W !!,"PATIENT",?22,"ENCOUNTER",?44,"APPOINTMENT",?66+8-5,"COUNT",! ;
. W "--------------------",?22,"--------------------",?44,"--------------------",?66,"--------",! ;
. S PTSTATUS="" F S PTSTATUS=$O(^TMP($J,PTSTATUS)) Q:PTSTATUS="" W PTSTATUS D ;
.. S ENCSTATUS="" F S ENCSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS)) Q:ENCSTATUS="" W ?22,ENCSTATUS D W ! ;
... S APPTSTATUS="" F S APPTSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS)) Q:APPTSTATUS="" W ?44,APPTSTATUS,?66,$J(^(APPTSTATUS),8),! ;
. ;
K ^TMP($J) ;
;
Q ;
;
SETCODES(FILE,FIELD,VALUE) ;
;
; Return text associated with a set of codes field in a file or sub-file.
;
; FILE = File number [REQUIRED]
; FIELD = Field number [REQUIRED]
; VALUE = Set of codes internal value [REQUIRED]
;
N DD,VALUES,RETURN,I ;
;
S DD=^DD(FILE,FIELD,0),VALUES=$P(DD,U,3),RETURN="" ;
F I=1:1 Q:$P(VALUES,";",I,99)="" I $P($P(VALUES,";",I),":",1)=VALUE S RETURN=$P($P(VALUES,";",I),":",2) Q ;
Q RETURN ;
;
PATCH(NUMBER) ;
;
; Determine if patch has been installed. Return installation date from Install file (#9.7).
;
N X,DA ;
S DA=$O(^XPD(9.7,"B","SD*5.3*"_NUMBER,99999),-1) I 'DA Q "" ;
S X=$P($G(^XPD(9.7,DA,0)),U,9) I X'=3 Q "" ;
Q $P($P($G(^XPD(9.7,DA,1)),U,3),".",1) ;
;
SHOWPAT(DFN,APPTDTTM) ;
;
; Display patient data.
;
; DFN = Pointer to #2 [REQUIRED]
; APPTDTTM = Appointment date/time [REQUIRED]
;
N DATA ;
;
W !?80-27/2,"*** PATIENT APPOINTMENT ***" ;
W !,"Patient: ",$$GET1^DIQ(2,DFN_",",.01),?40,"Appointment date/time: ",$$FMTE^XLFDT(APPTDTTM,2),! ;
;
S DATA=$G(^DPT(DFN,"S",APPTDTTM,0)) ; ICR #7030
W "Clinic: ",$$GET1^DIQ(44,$P(DATA,U,1)_",",.01),?40,"Status: ",$S($P(DATA,U,2)'="":$$SETCODES(2.98,3,$P(DATA,U,2)),1:"null"),! ;
W "Date appointment made: ",$$FMTE^XLFDT($P($P(DATA,U,19),".",1),2),?40,"By: ",$$GET1^DIQ(200,$P(DATA,U,18)_",",.01),! ;
Q ;
;
SHOWENC(ENCOUNTER) ;
;
; Display encounter data.
;
; ENCOUNTER = Pointer to #409.68 [REQUIRED]
;
N DATA,USER,COUNT,DA ;
;
; DATA = Encounter file record
; USER = "USER" node from Encounter file
; COUNT = Number of child encounters
;
W !?80-17/2,"*** ENCOUNTER ***" ;
I 'ENCOUNTER W !,"Encounter date: NO ENCOUNTER",! Q ;
;
S DATA=$G(^SCE(ENCOUNTER,0)),USER=$G(^SCE(ENCOUNTER,"USER")) ;
W !,"Encounter date: ",$$FMTE^XLFDT($P(DATA,U,1),2),! ;
W "Clinic: ",$$GET1^DIQ(44,$P(DATA,U,4)_",",.01),?40,"Status: ",$S($P(DATA,U,12)'="":$$GET1^DIQ(409.63,$P(DATA,U,12)_",",.01),1:"null"),! ;
W "Date created: ",$$FMTE^XLFDT($P($P(USER,U,4),".",1),2),?40,"By: ",$$GET1^DIQ(200,$P(USER,U,3)_",",.01),! ;
;
; Show if encounter is a parent or child encounter.
;
S COUNT=0,DA=0 F S DA=$O(^SCE("APAR",ENCOUNTER,DA)) Q:'DA S COUNT=COUNT+1 ;
;
W $S($P(DATA,U,6)'="":"Child encounter",1:"NOT a Child encounter") ;
W ?40,$S(COUNT:"Parent of "_COUNT_" encounters",1:"NOT a Parent encounter"),! ;
;
; Show number of dependent entries.
;
W "Number of dependent entries: ",$$DEPNDENT(ENCOUNTER),! ;
;
Q ;
;
DEPNDENT(ENCOUNTER) ;
;
; Return number of dependent entries for an encounter
;
N PXQRECI,X,Y,COUNT ;
;
S PXQRECI=0,X=$$DEC^PXQFE(ENCOUNTER,1,""),Y=$O(^TMP("PXQRECORD",$J,PXQRECI,"")),COUNT=$P(Y,"COUNT= ",2) K ^TMP("PXQRECORD",$J) ;
Q COUNT ;
;
SHOWAPPT(APPTIEN) ;
;
; Display appointment data.
;
; APPTIEN = Appointment (pointer to #409.84) [REQUIRED]
;
N DATA ;
;
W !?80-19/2,"*** APPOINTMENT ***" ;
I 'APPTIEN W !,"No appointment on file",! Q ;
;
S DATA=$G(^SDEC(409.84,APPTIEN,0)) ;
W !,"Resource: ",$$GET1^DIQ(409.831,$P(DATA,U,7)_",",.01),?40,"Status: ",$S($P(DATA,U,17)'="":$$SETCODES(409.84,.17,$P(DATA,U,17)),1:"null"),! ;
W "Date appointment made: ",$$FMTE^XLFDT($P(DATA,U,9),2),?40,"By: ",$$GET1^DIQ(200,$P(DATA,U,8)_",",.01),! ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECSTSR 8279 printed Apr 09, 2024@21:48:59 Page 2
SDECSTSR ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM
+1 ;;5.3;Scheduling;**737**;;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ; Report and fix appointment-encounter-appointment status triples from, respectively, the patient file (#2), the encounter file (#409.68) and
+6 ; the appointment file (#409.84).
+7 ;
+8 ; Distinguish encounter status from before and after installation of patch 722 - 9/11/2019
+9 ;
+10 ; ICR
+11 ; ---
+12 ; 7030 - #2 patient appointment data
+13 ;
DOWNLOAD ;
+1 ;
+2 ; Generate summary of appointment-encounter-appointment triples in comma-delimited format that can be uploaded to Excel.
+3 ;
+4 ; NOTE: This download is an analysis tool run by programmers. It is not linked to an option.
+5 ;
+6 ;
WRITE !!,"Generate summary of patient appointment-encounter-appointment file status triples in comma delimited format",!
+7 ;
+8 ;
NEW TYPE
SET TYPE="DOWNLOAD"
GOTO SUMMARY1
+9 ;
SUMMARY ;
+1 ;
+2 ; Generate summary of appointment-encounter-appointment triples in report format.
+3 ;
+4 ; NOTE: This report is an analysis tool run by programmers. It is not linked to an option.
+5 ;
+6 ;
WRITE !!,"Generate summary of patient appointment-encounter-appointment file status triples in report format",!
+7 ;
+8 ;
NEW TYPE
SET TYPE="REPORT"
+9 ;
SUMMARY1 ;
+1 ;
+2 ;
NEW %DT,START,Y,NAME,DFN,DTTM,PTDATA,PTSTATUS,ENCOUNTER,ENCDATA,ENCSTATUS,APPTDATA,APPTSTATUS,FOUND,I
+3 ;
NEW PATCH,ENCDATE,LASTDATE
+4 ;
+5 ; Determine date that patch 722 was installed.
+6 ;
+7 ;
SET PATCH=$$PATCH(722)
+8 ;
+9 ; Do not look at encounters that are less than a week old.
+10 ;
+11 ;
SET LASTDATE=$PIECE($$FMADD^XLFDT($$NOW^XLFDT(),-7),".",1)
+12 ;
+13 ; Scan is in date order starting with the user indicated date.
+14 ;
+15 ;
WRITE !,"Select appointment starting date",!
+16 ;
SET %DT="AX"
DO ^%DT
if Y<0
QUIT
SET START=$PIECE(Y,".",1)
WRITE !
+17 ;
+18 ;
KILL ^TMP($JOB)
+19 ;
+20 ; Scan patient file in alphabetic order. Process patients that have appointments after the selected start date.
+21 ;
+22 ;
SET NAME=""
FOR I=1:1
SET NAME=$ORDER(^DPT("B",NAME))
if NAME=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^DPT("B",NAME,DFN))
if 'DFN
QUIT
if I#1000=0
WRITE "."
IF $ORDER(^DPT(DFN,"S",START))>0
Begin DoDot:1
+23 ;
+24 ; Scan patient's appointments.
+25 ;
+26 ; ICR #7030
SET DTTM=START
FOR
SET DTTM=$ORDER(^DPT(DFN,"S",DTTM))
if 'DTTM
QUIT
if DTTM>LASTDATE
QUIT
SET PTDATA=^(DTTM,0)
Begin DoDot:2
+27 ;
+28 ; Get status of appointment in patient file.
+29 ;
+30 ; ICR #7030
SET PTSTATUS=$SELECT($PIECE(PTDATA,U,2)'="":$$SETCODES(2.98,3,$PIECE(PTDATA,U,2)),1:"null")
+31 ;
+32 ; Get encounter from patient's appointment record and the status of the encounter from file.
+33 ;
+34 ;
SET ENCOUNTER=$PIECE(PTDATA,U,20)
SET ENCSTATUS=$SELECT(ENCOUNTER:$PIECE($GET(^SCE(ENCOUNTER,0)),U,12),1:"")
SET ENCSTATUS=$SELECT(ENCOUNTER="":"NONE",ENCSTATUS="":"null",1:$$GET1^DIQ(409.63,ENCSTATUS_",",.01))
+35 ;
+36 ; Flag encounter status as BEFORE or AFTER patch 722 installation.
+37 ;
+38 ;
IF ENCSTATUS'="NONE"
SET ENCDATE=$PIECE($GET(^SCE(ENCOUNTER,"USER")),U,4)
SET ENCSTATUS=ENCSTATUS_"-"_$SELECT(ENCDATE="":"NO DATE",ENCDATE<PATCH:"BEFORE",1:"AFTER")
+39 ;
+40 ; Scan appointments in the appointment time for the date/time of the appointment in the patient file.
+41 ;
+42 ;
SET DA=0
SET FOUND=0
FOR
SET DA=$ORDER(^SDEC(409.84,"APTDT",DFN,DTTM,DA))
if 'DA
QUIT
SET APPTDATA=$GET(^SDEC(409.84,DA,0))
IF APPTDATA'=""
SET FOUND=1
Begin DoDot:3
+43 ;
+44 ; Get status of appointments in appointment file. Update count of triple.
+45 ;
+46 ;
SET APPTSTATUS=$SELECT($PIECE(APPTDATA,U,17)'="":$$SETCODES(409.84,.17,$PIECE(APPTDATA,U,17)),1:"null")
+47 ;
SET ^(APPTSTATUS)=$GET(^TMP($JOB,PTSTATUS,ENCSTATUS,APPTSTATUS))+1
End DoDot:3
+48 ;
+49 ; If no matching appointments (FOUND=0), update count for "status" of NONE.
+50 ;
+51 ;
IF 'FOUND
SET ^("NONE")=$GET(^TMP($JOB,PTSTATUS,ENCSTATUS,"NONE"))+1
End DoDot:2
End DoDot:1
+52 ;
+53 ; If download selected, output results in comma-delimited format
+54 ;
+55 ;
IF TYPE="DOWNLOAD"
Begin DoDot:1
+56 ;
WRITE !,$CHAR(34),"PATIENT"_$CHAR(34),",",$CHAR(34),"ENCOUNTER",$CHAR(34),",",$CHAR(34),"APPOINTMENT",$CHAR(34),",",$CHAR(34)_"COUNT",$CHAR(34),!
+57 ;
SET PTSTATUS=""
FOR
SET PTSTATUS=$ORDER(^TMP($JOB,PTSTATUS))
if PTSTATUS=""
QUIT
Begin DoDot:2
+58 ;
SET ENCSTATUS=""
FOR
SET ENCSTATUS=$ORDER(^TMP($JOB,PTSTATUS,ENCSTATUS))
if ENCSTATUS=""
QUIT
Begin DoDot:3
+59 ;
SET APPTSTATUS=""
FOR
SET APPTSTATUS=$ORDER(^TMP($JOB,PTSTATUS,ENCSTATUS,APPTSTATUS))
if APPTSTATUS=""
QUIT
WRITE $CHAR(34),PTSTATUS,$CHAR(34),",",$CHAR(34),ENCSTATUS,$CHAR(34),",",$CHAR(34),APPTSTATUS,$CHAR(34),",",^(APPTSTATUS),!
End DoDot:3
End DoDot:2
+60 ;
End DoDot:1
+61 ;
+62 ; If report selected, output formatted report.
+63 ;
+64 ;
IF TYPE="REPORT"
Begin DoDot:1
+65 ;
WRITE !!,"PATIENT",?22,"ENCOUNTER",?44,"APPOINTMENT",?66+8-5,"COUNT",!
+66 ;
WRITE "--------------------",?22,"--------------------",?44,"--------------------",?66,"--------",!
+67 ;
SET PTSTATUS=""
FOR
SET PTSTATUS=$ORDER(^TMP($JOB,PTSTATUS))
if PTSTATUS=""
QUIT
WRITE PTSTATUS
Begin DoDot:2
+68 ;
SET ENCSTATUS=""
FOR
SET ENCSTATUS=$ORDER(^TMP($JOB,PTSTATUS,ENCSTATUS))
if ENCSTATUS=""
QUIT
WRITE ?22,ENCSTATUS
Begin DoDot:3
+69 ;
SET APPTSTATUS=""
FOR
SET APPTSTATUS=$ORDER(^TMP($JOB,PTSTATUS,ENCSTATUS,APPTSTATUS))
if APPTSTATUS=""
QUIT
WRITE ?44,APPTSTATUS,?66,$JUSTIFY(^(APPTSTATUS),8),!
End DoDot:3
WRITE !
End DoDot:2
+70 ;
End DoDot:1
+71 ;
KILL ^TMP($JOB)
+72 ;
+73 ;
QUIT
+74 ;
SETCODES(FILE,FIELD,VALUE) ;
+1 ;
+2 ; Return text associated with a set of codes field in a file or sub-file.
+3 ;
+4 ; FILE = File number [REQUIRED]
+5 ; FIELD = Field number [REQUIRED]
+6 ; VALUE = Set of codes internal value [REQUIRED]
+7 ;
+8 ;
NEW DD,VALUES,RETURN,I
+9 ;
+10 ;
SET DD=^DD(FILE,FIELD,0)
SET VALUES=$PIECE(DD,U,3)
SET RETURN=""
+11 ;
FOR I=1:1
if $PIECE(VALUES,";",I,99)=""
QUIT
IF $PIECE($PIECE(VALUES,";",I),":",1)=VALUE
SET RETURN=$PIECE($PIECE(VALUES,";",I),":",2)
QUIT
+12 ;
QUIT RETURN
+13 ;
PATCH(NUMBER) ;
+1 ;
+2 ; Determine if patch has been installed. Return installation date from Install file (#9.7).
+3 ;
+4 ;
NEW X,DA
+5 ;
SET DA=$ORDER(^XPD(9.7,"B","SD*5.3*"_NUMBER,99999),-1)
IF 'DA
QUIT ""
+6 ;
SET X=$PIECE($GET(^XPD(9.7,DA,0)),U,9)
IF X'=3
QUIT ""
+7 ;
QUIT $PIECE($PIECE($GET(^XPD(9.7,DA,1)),U,3),".",1)
+8 ;
SHOWPAT(DFN,APPTDTTM) ;
+1 ;
+2 ; Display patient data.
+3 ;
+4 ; DFN = Pointer to #2 [REQUIRED]
+5 ; APPTDTTM = Appointment date/time [REQUIRED]
+6 ;
+7 ;
NEW DATA
+8 ;
+9 ;
WRITE !?80-27/2,"*** PATIENT APPOINTMENT ***"
+10 ;
WRITE !,"Patient: ",$$GET1^DIQ(2,DFN_",",.01),?40,"Appointment date/time: ",$$FMTE^XLFDT(APPTDTTM,2),!
+11 ;
+12 ; ICR #7030
SET DATA=$GET(^DPT(DFN,"S",APPTDTTM,0))
+13 ;
WRITE "Clinic: ",$$GET1^DIQ(44,$PIECE(DATA,U,1)_",",.01),?40,"Status: ",$SELECT($PIECE(DATA,U,2)'="":$$SETCODES(2.98,3,$PIECE(DATA,U,2)),1:"null"),!
+14 ;
WRITE "Date appointment made: ",$$FMTE^XLFDT($PIECE($PIECE(DATA,U,19),".",1),2),?40,"By: ",$$GET1^DIQ(200,$PIECE(DATA,U,18)_",",.01),!
+15 ;
QUIT
+16 ;
SHOWENC(ENCOUNTER) ;
+1 ;
+2 ; Display encounter data.
+3 ;
+4 ; ENCOUNTER = Pointer to #409.68 [REQUIRED]
+5 ;
+6 ;
NEW DATA,USER,COUNT,DA
+7 ;
+8 ; DATA = Encounter file record
+9 ; USER = "USER" node from Encounter file
+10 ; COUNT = Number of child encounters
+11 ;
+12 ;
WRITE !?80-17/2,"*** ENCOUNTER ***"
+13 ;
IF 'ENCOUNTER
WRITE !,"Encounter date: NO ENCOUNTER",!
QUIT
+14 ;
+15 ;
SET DATA=$GET(^SCE(ENCOUNTER,0))
SET USER=$GET(^SCE(ENCOUNTER,"USER"))
+16 ;
WRITE !,"Encounter date: ",$$FMTE^XLFDT($PIECE(DATA,U,1),2),!
+17 ;
WRITE "Clinic: ",$$GET1^DIQ(44,$PIECE(DATA,U,4)_",",.01),?40,"Status: ",$SELECT($PIECE(DATA,U,12)'="":$$GET1^DIQ(409.63,$PIECE(DATA,U,12)_",",.01),1:"null"),!
+18 ;
WRITE "Date created: ",$$FMTE^XLFDT($PIECE($PIECE(USER,U,4),".",1),2),?40,"By: ",$$GET1^DIQ(200,$PIECE(USER,U,3)_",",.01),!
+19 ;
+20 ; Show if encounter is a parent or child encounter.
+21 ;
+22 ;
SET COUNT=0
SET DA=0
FOR
SET DA=$ORDER(^SCE("APAR",ENCOUNTER,DA))
if 'DA
QUIT
SET COUNT=COUNT+1
+23 ;
+24 ;
WRITE $SELECT($PIECE(DATA,U,6)'="":"Child encounter",1:"NOT a Child encounter")
+25 ;
WRITE ?40,$SELECT(COUNT:"Parent of "_COUNT_" encounters",1:"NOT a Parent encounter"),!
+26 ;
+27 ; Show number of dependent entries.
+28 ;
+29 ;
WRITE "Number of dependent entries: ",$$DEPNDENT(ENCOUNTER),!
+30 ;
+31 ;
QUIT
+32 ;
DEPNDENT(ENCOUNTER) ;
+1 ;
+2 ; Return number of dependent entries for an encounter
+3 ;
+4 ;
NEW PXQRECI,X,Y,COUNT
+5 ;
+6 ;
SET PXQRECI=0
SET X=$$DEC^PXQFE(ENCOUNTER,1,"")
SET Y=$ORDER(^TMP("PXQRECORD",$JOB,PXQRECI,""))
SET COUNT=$PIECE(Y,"COUNT= ",2)
KILL ^TMP("PXQRECORD",$JOB)
+7 ;
QUIT COUNT
+8 ;
SHOWAPPT(APPTIEN) ;
+1 ;
+2 ; Display appointment data.
+3 ;
+4 ; APPTIEN = Appointment (pointer to #409.84) [REQUIRED]
+5 ;
+6 ;
NEW DATA
+7 ;
+8 ;
WRITE !?80-19/2,"*** APPOINTMENT ***"
+9 ;
IF 'APPTIEN
WRITE !,"No appointment on file",!
QUIT
+10 ;
+11 ;
SET DATA=$GET(^SDEC(409.84,APPTIEN,0))
+12 ;
WRITE !,"Resource: ",$$GET1^DIQ(409.831,$PIECE(DATA,U,7)_",",.01),?40,"Status: ",$SELECT($PIECE(DATA,U,17)'="":$$SETCODES(409.84,.17,$PIECE(DATA,U,17)),1:"null"),!
+13 ;
WRITE "Date appointment made: ",$$FMTE^XLFDT($PIECE(DATA,U,9),2),?40,"By: ",$$GET1^DIQ(200,$PIECE(DATA,U,8)_",",.01),!
+14 ;
QUIT
+15 ;
