- 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 Jan 18, 2025@04:02:37 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