VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998
;;5.3;Registration;**209**;Aug 13, 1993
;
LISTMAN ;Entry point for ListMan interface to transmit admission data
;Input : None
;Output : None
;
N DFN,VALMBEG,VALMEND
AGAIN ;Get patient
S DFN=$$GETDFN()
Q:(DFN<0)
I ('$D(^DGPM("APTT1",DFN))) W !!,"** No admissions on file **",!! G AGAIN
;Call ListMan
D EN^VALM("VAFC ADMISSION TRANSMISSION")
;Done
Q
;
GETDFN() ;Get pointer to PATIENT file (#2)
;Input : None
;Output : DFN - Pointer to PATIENT file (#2)
; -1 - No entry selected
;
N DIC,X,Y,DTOUT,DUOUT
S DIC="^DPT("
S DIC(0)="AEMNQZ"
D ^DIC
Q +Y
;
;Input : DFN - Pointer to PATIENT file (#2)
; VALMEND - Ending date range (FileMan)
; Defaults to Today
; VALMBEG - Beginning date range (FileMan)
; Defaults to VALMEND-45
;Output : VALMHDR(x) = Line of text in header
;Notes : VALMBEG & VALMEND will be defined on ouput
;
;Check input
Q:('$G(DFN))
Q:('$D(^DPT(DFN)))
S VALMEND=$G(VALMEND,$$DT^XLFDT())
S VALMBEG=$G(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
;Declare variables
N LINE,TMP,VA,VAPTYP,VAERR
D PID^VADPT6
Q:(VAERR)
S TMP="Admissions for "_$P(^DPT(DFN,0),"^",1)
S TMP=TMP_" ("_VA("PID")_")"
S LINE=TMP
S TMP=$L(LINE)
S VALMHDR(1)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
S TMP=$$FMTE^XLFDT(VALMBEG,"1D")
S TMP=TMP_" through "_$$FMTE^XLFDT(VALMEND,"1D")
S LINE=TMP
S TMP=$L(LINE)
S VALMHDR(2)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
Q
;
ENTRY ;Build display list of admissions for given patient in given time frame
;Input : DFN - Pointer to PATIENT file (#2)
; VALMEND - Ending date range (FileMan)
; Defaults to Today
; VALMBEG - Beginning date range (FileMan)
; Defaults to VALMEND-45
;Output : @VALMAR@(x) = Line of text in ListMan display
; @VALMAR@("IDX",x,y) = "" (Index array for entry selection)
;Notes : VALMBEG & VALMEND will be defined on ouput
;
;Check input (strip time from VALMEND & VALMBEG)
Q:('$G(DFN))
Q:('$D(^DPT(DFN)))
S VALMEND=$G(VALMEND,$$DT^XLFDT())
S VALMEND=$P(VALMEND,".",1)
S VALMBEG=$G(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
S VALMBEG=$P(VALMBEG,".",1)
;Declare variables
N MOVEPTR,DATE,MOVENODE,TMP,LINE,ENTRY,NODE,INVBEG
D CLEAN^VALM10
S VALMCNT=1
S VALMBG=1
S ENTRY=0
S INVBEG=9999999.9999999-VALMBEG
S INVBEG=$P(INVBEG,".",1)
;Loop through admissions for patient
S DATE=9999999.9999999-VALMEND
S DATE=$P(DATE,".",1)
F S DATE=+$O(^DGPM("ATID1",DFN,DATE)) Q:(('DATE)!($P(DATE,".",1)>INVBEG)) D
.S MOVEPTR=""
.F S MOVEPTR=+$O(^DGPM("ATID1",DFN,DATE,MOVEPTR)) Q:('MOVEPTR) D
..S MOVENODE=$G(^DGPM(MOVEPTR,0))
..Q:('(+MOVENODE))
..S LINE=""
..;Increment choice number
..S ENTRY=ENTRY+1
..S LINE=$$SETFLD^VALM1(ENTRY,LINE,"ENTRY")
..;Movement date/time
..S TMP=$$FMTE^XLFDT(+MOVENODE)
..S LINE=$$SETFLD^VALM1(TMP,LINE,"DATE")
..;Movement type
..S TMP=+$P(MOVENODE,"^",4)
..S NODE=$G(^DG(405.1,TMP,0))
..S TMP=$P(NODE,"^",7)
..S:(TMP="") TMP=$P(NODE,"^",1)
..S LINE=$$SETFLD^VALM1(TMP,LINE,"MOVEMENT")
..;Ward
..S TMP=+$P(MOVENODE,"^",6)
..S NODE=$G(^DIC(42,TMP,0))
..S TMP=$P(NODE,"^",1)
..S LINE=$$SETFLD^VALM1(TMP,LINE,"WARD")
..;Add entry to display & index and increment line count
..D SET^VALM10(VALMCNT,LINE,ENTRY)
..S @VALMAR@("INDEX",ENTRY)=MOVEPTR
..S VALMCNT=VALMCNT+1
..Q
.Q
;Decrement line count by one
S VALMCNT=VALMCNT-1
;No admissions within date range
I ('ENTRY) D
.S @VALMAR@(1,0)=""
.S LINE="** NO ADMISSIONS FOUND WITHIN GIVEN DATE RANGE **"
.S:('$D(^DGPM("APTT1",DFN))) LINE="** NO ADMISSIONS ON FILE **"
.S TMP=$L(LINE)
.S @VALMAR@(2,0)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
.S VALMCNT=1
Q
;
EXIT ;Clean-up ListMan variables
D CLEAN^VALM10
;Return to full screen mode
D FULL^VALM1
Q
;
; --- LISTMAN PROTOCOLS ---
;
DATE ;Change date range
;Input : Variables set by ListMan
;Output : None
;Notes : VALMBEG & VALMEND will be updated with the new date range
;
;Declare variables
N VALMB,OLDBEG,OLDEND
;Remember current date range
S OLDBED=VALMBEG
S OLDEND=VALMEND
;Switch to full screen mode
D FULL^VALM1
;Prompt for new date range (default begin date is T-45)
S VALMB=$$FMADD^XLFDT($$DT^XLFDT(),-45)
D RANGE^VALM1
;New date range not entered
I (('VALMBEG)!('VALMEND)) D Q
.S VALMBEG=OLDBED
.S VALMEND=OLDEND
.S VALMBCK="R"
;Rebuild header
D HEADER
;Rebuild display
D ENTRY
;Done
S VALMBCK="R"
Q
;
XMIT ;Select and transmit admission from list
;Input : Variables set by ListMan
; DFN - Pointer to PATIENT file (#2)
;Output : None
;Notes : Entry for selected admission will be found/created in
; ADT/HL7 PIVOT file (#391.71) and then transmitted
;
;Declare variables
N VALMY,ENTRY,MOVEPTR,PIVOTNUM,PIVOT,DATE,VPTR,DIR,X,Y
;Switch to full screen mode
D FULL^VALM1
;Prompt for selection
D EN^VALM2(XQORNOD(0),"SO")
;Loop through selections
S ENTRY=0
F S ENTRY=+$O(VALMY(ENTRY)) Q:('ENTRY) D
.;Convert selection number to PATIENT MOVEMENT file pointer
.S MOVEPTR=+$G(@VALMAR@("INDEX",ENTRY))
.;Get date/time of admission
.S DATE=+$G(^DGPM(MOVEPTR,0))
.I ('DATE) D Q
..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
..W !," COULD NOT FIND ENTRY IN PATIENT MOVEMENT FILE"
..W !!
..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
.;Create/find entry in ADT/HL7 PIVOT file (call returns pivot number)
.S VPTR=MOVEPTR_";DGPM("
.S PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,DATE,1,VPTR)
.I ('PIVOTNUM) D Q
..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
..W !," UNABLE TO CREATE/FIND ENTRY IN ADT/HL7 PIVOT FILE"
..W !!
..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
.;Convert pivot number to pointer
.S PIVOTPTR=+$O(^VAT(391.71,"D",PIVOTNUM,0))
.I ('PIVOTPTR) D Q
..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
..W !," COULD NOT FIND ENTRY IN ADT/HL7 PIVOT FILE"
..W !!
..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
.;Queue retransmission
.D RETRAN^VAFCMS02(PIVOTPTR)
.W !,"Entry number ",ENTRY," queued for transmission"
.S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
S VALMBCK="R"
Q
;
NEWDFN ;Change patient
;Input : Variables set by ListMan
; DFN - Pointer to PATIENT file (#2)
;Output : None
;Notes : DFN will be updated with the newly selected patient
; : VALMBEG & VALMEND will not be modified
;
;Declare variables
N OLDDFN
;Switch to full screen mode
D FULL^VALM1
;Remember current DFN
S OLDDFN=DFN
;Prompt for patient
S DFN=$$GETDFN()
;New patient not selected
I (DFN<0) S DFN=OLDDFN S VALMBCK="R" Q
;Rebuild header
D HEADER
;Rebuild display
D ENTRY
;Done
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMS01 7003 printed Dec 13, 2024@03:01:56 Page 2
VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998
+1 ;;5.3;Registration;**209**;Aug 13, 1993
+2 ;
LISTMAN ;Entry point for ListMan interface to transmit admission data
+1 ;Input : None
+2 ;Output : None
+3 ;
+4 NEW DFN,VALMBEG,VALMEND
AGAIN ;Get patient
+1 SET DFN=$$GETDFN()
+2 if (DFN<0)
QUIT
+3 IF ('$DATA(^DGPM("APTT1",DFN)))
WRITE !!,"** No admissions on file **",!!
GOTO AGAIN
+4 ;Call ListMan
+5 DO EN^VALM("VAFC ADMISSION TRANSMISSION")
+6 ;Done
+7 QUIT
+8 ;
GETDFN() ;Get pointer to PATIENT file (#2)
+1 ;Input : None
+2 ;Output : DFN - Pointer to PATIENT file (#2)
+3 ; -1 - No entry selected
+4 ;
+5 NEW DIC,X,Y,DTOUT,DUOUT
+6 SET DIC="^DPT("
+7 SET DIC(0)="AEMNQZ"
+8 DO ^DIC
+9 QUIT +Y
+10 ;
+1 ;Input : DFN - Pointer to PATIENT file (#2)
+2 ; VALMEND - Ending date range (FileMan)
+3 ; Defaults to Today
+4 ; VALMBEG - Beginning date range (FileMan)
+5 ; Defaults to VALMEND-45
+6 ;Output : VALMHDR(x) = Line of text in header
+7 ;Notes : VALMBEG & VALMEND will be defined on ouput
+8 ;
+9 ;Check input
+10 if ('$GET(DFN))
QUIT
+11 if ('$DATA(^DPT(DFN)))
QUIT
+12 SET VALMEND=$GET(VALMEND,$$DT^XLFDT())
+13 SET VALMBEG=$GET(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
+14 ;Declare variables
+15 NEW LINE,TMP,VA,VAPTYP,VAERR
+16 DO PID^VADPT6
+17 if (VAERR)
QUIT
+18 SET TMP="Admissions for "_$PIECE(^DPT(DFN,0),"^",1)
+19 SET TMP=TMP_" ("_VA("PID")_")"
+20 SET LINE=TMP
+21 SET TMP=$LENGTH(LINE)
+22 SET VALMHDR(1)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
+23 SET TMP=$$FMTE^XLFDT(VALMBEG,"1D")
+24 SET TMP=TMP_" through "_$$FMTE^XLFDT(VALMEND,"1D")
+25 SET LINE=TMP
+26 SET TMP=$LENGTH(LINE)
+27 SET VALMHDR(2)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
+28 QUIT
+29 ;
ENTRY ;Build display list of admissions for given patient in given time frame
+1 ;Input : DFN - Pointer to PATIENT file (#2)
+2 ; VALMEND - Ending date range (FileMan)
+3 ; Defaults to Today
+4 ; VALMBEG - Beginning date range (FileMan)
+5 ; Defaults to VALMEND-45
+6 ;Output : @VALMAR@(x) = Line of text in ListMan display
+7 ; @VALMAR@("IDX",x,y) = "" (Index array for entry selection)
+8 ;Notes : VALMBEG & VALMEND will be defined on ouput
+9 ;
+10 ;Check input (strip time from VALMEND & VALMBEG)
+11 if ('$GET(DFN))
QUIT
+12 if ('$DATA(^DPT(DFN)))
QUIT
+13 SET VALMEND=$GET(VALMEND,$$DT^XLFDT())
+14 SET VALMEND=$PIECE(VALMEND,".",1)
+15 SET VALMBEG=$GET(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
+16 SET VALMBEG=$PIECE(VALMBEG,".",1)
+17 ;Declare variables
+18 NEW MOVEPTR,DATE,MOVENODE,TMP,LINE,ENTRY,NODE,INVBEG
+19 DO CLEAN^VALM10
+20 SET VALMCNT=1
+21 SET VALMBG=1
+22 SET ENTRY=0
+23 SET INVBEG=9999999.9999999-VALMBEG
+24 SET INVBEG=$PIECE(INVBEG,".",1)
+25 ;Loop through admissions for patient
+26 SET DATE=9999999.9999999-VALMEND
+27 SET DATE=$PIECE(DATE,".",1)
+28 FOR
SET DATE=+$ORDER(^DGPM("ATID1",DFN,DATE))
if (('DATE)!($PIECE(DATE,".",1)>INVBEG))
QUIT
Begin DoDot:1
+29 SET MOVEPTR=""
+30 FOR
SET MOVEPTR=+$ORDER(^DGPM("ATID1",DFN,DATE,MOVEPTR))
if ('MOVEPTR)
QUIT
Begin DoDot:2
+31 SET MOVENODE=$GET(^DGPM(MOVEPTR,0))
+32 if ('(+MOVENODE))
QUIT
+33 SET LINE=""
+34 ;Increment choice number
+35 SET ENTRY=ENTRY+1
+36 SET LINE=$$SETFLD^VALM1(ENTRY,LINE,"ENTRY")
+37 ;Movement date/time
+38 SET TMP=$$FMTE^XLFDT(+MOVENODE)
+39 SET LINE=$$SETFLD^VALM1(TMP,LINE,"DATE")
+40 ;Movement type
+41 SET TMP=+$PIECE(MOVENODE,"^",4)
+42 SET NODE=$GET(^DG(405.1,TMP,0))
+43 SET TMP=$PIECE(NODE,"^",7)
+44 if (TMP="")
SET TMP=$PIECE(NODE,"^",1)
+45 SET LINE=$$SETFLD^VALM1(TMP,LINE,"MOVEMENT")
+46 ;Ward
+47 SET TMP=+$PIECE(MOVENODE,"^",6)
+48 SET NODE=$GET(^DIC(42,TMP,0))
+49 SET TMP=$PIECE(NODE,"^",1)
+50 SET LINE=$$SETFLD^VALM1(TMP,LINE,"WARD")
+51 ;Add entry to display & index and increment line count
+52 DO SET^VALM10(VALMCNT,LINE,ENTRY)
+53 SET @VALMAR@("INDEX",ENTRY)=MOVEPTR
+54 SET VALMCNT=VALMCNT+1
+55 QUIT
End DoDot:2
+56 QUIT
End DoDot:1
+57 ;Decrement line count by one
+58 SET VALMCNT=VALMCNT-1
+59 ;No admissions within date range
+60 IF ('ENTRY)
Begin DoDot:1
+61 SET @VALMAR@(1,0)=""
+62 SET LINE="** NO ADMISSIONS FOUND WITHIN GIVEN DATE RANGE **"
+63 if ('$DATA(^DGPM("APTT1",DFN)))
SET LINE="** NO ADMISSIONS ON FILE **"
+64 SET TMP=$LENGTH(LINE)
+65 SET @VALMAR@(2,0)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
+66 SET VALMCNT=1
End DoDot:1
+67 QUIT
+68 ;
EXIT ;Clean-up ListMan variables
+1 DO CLEAN^VALM10
+2 ;Return to full screen mode
+3 DO FULL^VALM1
+4 QUIT
+5 ;
+6 ; --- LISTMAN PROTOCOLS ---
+7 ;
DATE ;Change date range
+1 ;Input : Variables set by ListMan
+2 ;Output : None
+3 ;Notes : VALMBEG & VALMEND will be updated with the new date range
+4 ;
+5 ;Declare variables
+6 NEW VALMB,OLDBEG,OLDEND
+7 ;Remember current date range
+8 SET OLDBED=VALMBEG
+9 SET OLDEND=VALMEND
+10 ;Switch to full screen mode
+11 DO FULL^VALM1
+12 ;Prompt for new date range (default begin date is T-45)
+13 SET VALMB=$$FMADD^XLFDT($$DT^XLFDT(),-45)
+14 DO RANGE^VALM1
+15 ;New date range not entered
+16 IF (('VALMBEG)!('VALMEND))
Begin DoDot:1
+17 SET VALMBEG=OLDBED
+18 SET VALMEND=OLDEND
+19 SET VALMBCK="R"
End DoDot:1
QUIT
+20 ;Rebuild header
+21 DO HEADER
+22 ;Rebuild display
+23 DO ENTRY
+24 ;Done
+25 SET VALMBCK="R"
+26 QUIT
+27 ;
XMIT ;Select and transmit admission from list
+1 ;Input : Variables set by ListMan
+2 ; DFN - Pointer to PATIENT file (#2)
+3 ;Output : None
+4 ;Notes : Entry for selected admission will be found/created in
+5 ; ADT/HL7 PIVOT file (#391.71) and then transmitted
+6 ;
+7 ;Declare variables
+8 NEW VALMY,ENTRY,MOVEPTR,PIVOTNUM,PIVOT,DATE,VPTR,DIR,X,Y
+9 ;Switch to full screen mode
+10 DO FULL^VALM1
+11 ;Prompt for selection
+12 DO EN^VALM2(XQORNOD(0),"SO")
+13 ;Loop through selections
+14 SET ENTRY=0
+15 FOR
SET ENTRY=+$ORDER(VALMY(ENTRY))
if ('ENTRY)
QUIT
Begin DoDot:1
+16 ;Convert selection number to PATIENT MOVEMENT file pointer
+17 SET MOVEPTR=+$GET(@VALMAR@("INDEX",ENTRY))
+18 ;Get date/time of admission
+19 SET DATE=+$GET(^DGPM(MOVEPTR,0))
+20 IF ('DATE)
Begin DoDot:2
+21 WRITE !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
+22 WRITE !," COULD NOT FIND ENTRY IN PATIENT MOVEMENT FILE"
+23 WRITE !!
+24 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue: "
DO ^DIR
End DoDot:2
QUIT
+25 ;Create/find entry in ADT/HL7 PIVOT file (call returns pivot number)
+26 SET VPTR=MOVEPTR_";DGPM("
+27 SET PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,DATE,1,VPTR)
+28 IF ('PIVOTNUM)
Begin DoDot:2
+29 WRITE !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
+30 WRITE !," UNABLE TO CREATE/FIND ENTRY IN ADT/HL7 PIVOT FILE"
+31 WRITE !!
+32 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue: "
DO ^DIR
End DoDot:2
QUIT
+33 ;Convert pivot number to pointer
+34 SET PIVOTPTR=+$ORDER(^VAT(391.71,"D",PIVOTNUM,0))
+35 IF ('PIVOTPTR)
Begin DoDot:2
+36 WRITE !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
+37 WRITE !," COULD NOT FIND ENTRY IN ADT/HL7 PIVOT FILE"
+38 WRITE !!
+39 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue: "
DO ^DIR
End DoDot:2
QUIT
+40 ;Queue retransmission
+41 DO RETRAN^VAFCMS02(PIVOTPTR)
+42 WRITE !,"Entry number ",ENTRY," queued for transmission"
+43 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue: "
DO ^DIR
End DoDot:1
+44 SET VALMBCK="R"
+45 QUIT
+46 ;
NEWDFN ;Change patient
+1 ;Input : Variables set by ListMan
+2 ; DFN - Pointer to PATIENT file (#2)
+3 ;Output : None
+4 ;Notes : DFN will be updated with the newly selected patient
+5 ; : VALMBEG & VALMEND will not be modified
+6 ;
+7 ;Declare variables
+8 NEW OLDDFN
+9 ;Switch to full screen mode
+10 DO FULL^VALM1
+11 ;Remember current DFN
+12 SET OLDDFN=DFN
+13 ;Prompt for patient
+14 SET DFN=$$GETDFN()
+15 ;New patient not selected
+16 IF (DFN<0)
SET DFN=OLDDFN
SET VALMBCK="R"
QUIT
+17 ;Rebuild header
+18 DO HEADER
+19 ;Rebuild display
+20 DO ENTRY
+21 ;Done
+22 SET VALMBCK="R"
+23 QUIT
