- GMTSDGH ; SLC/MKB,KER/NDBI - Patient Hist by admissions ; 02/27/2002
- ;;2.7;Health Summary;**28,49**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 17 ^DGPM("APCA"
- ; DBIA 17 ^DGPM("ATID1"
- ; DBIA 17 ^DGPM("ATS"
- ; DBIA 2929 DSP^A7RHSM
- ; DBIA 2929 LST^A7RHSM
- ; DBIA 10061 IN5^VADPT
- ; DBIA 10061 KVAR^VADPT
- ;
- MAIN ; Loop through admissions starting from most recent
- N VAHOW
- K VAIP
- I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
- E S CNTR=100
- S VA200=1,VAHOW=1,FLAG=-1,ADM=GMTS1
- D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)
- F S ADM=$O(^DGPM("ATID1",DFN,ADM)) D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) DSP^A7RHSM(ADM) Q:('ADM)!(ADM>GMTS2)!(CNTR=0)!('DFN) D MVTS
- D KILVAR K:$$NDBI^GMTSU A7RHS
- Q
- MVTS ; Loop through mvts chronologically, per admission
- S ADA=0,ADA=$O(^DGPM("ATID1",DFN,ADM,ADA)) Q:'ADA
- K VAIP,PREVDR,PREVSP,^UTILITY($J)
- S VAIP("E")=ADA D IN5^VADPT
- I $D(VAIP) D CKP^GMTSUP Q:$D(GMTSQIT) W:FLAG>0 ! D PRNT
- D SETUTL
- S MDM="" F S MDM=$O(^UTILITY($J,"GMTSMVTS",MDM)) Q:'MDM D GET
- S CNTR=CNTR-1
- Q
- GET ; Get Inpatient Data [v5.0 and above]
- I ^UTILITY($J,"GMTSMVTS",MDM)=ADA Q
- K VAIP S VAIP("E")=^UTILITY($J,"GMTSMVTS",MDM) D IN5^VADPT
- I $D(VAIP) D PRNT
- Q
- PRNT ; Output Data
- S X=+$P(VAIP("MD"),U) D REGDT4^GMTSU
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S DOC=$E($P(VAIP("DR"),U,2),1,10),TYPE=$P(VAIP("MT"),U,2),CODE=+$P(VAIP("TT"),U),SPEC=$E($P(VAIP("TS"),U,2),1,12)
- S TT=$S(CODE=0:"NON",CODE=1:"ADM",CODE=2:"TR ",CODE=3:"DC ",CODE=4:"CIL",CODE=5:"COL",CODE=6:"TS ",1:" ")
- I 'GMTSNPG,$D(PREVDR),PREVDR=$P(VAIP("DR"),U) S DOC=" "" "
- I 'GMTSNPG,$D(PREVSP),PREVSP=$P(VAIP("TS"),U) S SPEC=" "" "
- W X,?12,TT," ",$E(TYPE,1,34),?55,SPEC,?69,DOC,!
- S FLAG=2,PREVDR=$P(VAIP("DR"),U),PREVSP=$P(VAIP("TS"),U)
- Q
- SETUTL ; Get Treating Specialty and Corresponding Admission
- S (TSDM,MDM)=0
- F S TSDM=$O(^DGPM("ATS",DFN,ADA,TSDM)) Q:'TSDM D NEXT1
- F S MDM=$O(^DGPM("APCA",DFN,ADA,MDM)) Q:'MDM D NEXT2
- Q
- NEXT1 ; Treating Specialty (ATS)
- S TS="",TS=$O(^DGPM("ATS",DFN,ADA,TSDM,TS)) Q:'TS
- S TSDA=0,TSDA=$O(^DGPM("ATS",DFN,ADA,TSDM,TS,TSDA)) Q:'TSDA
- S ^UTILITY($J,"GMTSMVTS",9999999-TSDM)=TSDA
- Q
- NEXT2 ; Corresponding Admission (APCA)
- S MDA=0,MDA=$O(^DGPM("APCA",DFN,ADA,MDM,MDA)) Q:'MDA
- I MDA'=ADA S ^UTILITY($J,"GMTSMVTS",MDM)=MDA
- Q
- KILVAR ; Clean-up, exit
- D KVAR^VADPT
- K FLAG,IN,IM,ADA,ADM,MDA,MDM,X,DOC,CNTR,CODE,TYPE,TT,PREVSP,PREVDR,SPEC
- K ITS,TS,TSDM,TSDA,^UTILITY($J)
- Q
- GMTSDGH ; SLC/MKB,KER/NDBI - Patient Hist by admissions ; 02/27/2002
- +1 ;;2.7;Health Summary;**28,49**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 17 ^DGPM("APCA"
- +5 ; DBIA 17 ^DGPM("ATID1"
- +6 ; DBIA 17 ^DGPM("ATS"
- +7 ; DBIA 2929 DSP^A7RHSM
- +8 ; DBIA 2929 LST^A7RHSM
- +9 ; DBIA 10061 IN5^VADPT
- +10 ; DBIA 10061 KVAR^VADPT
- +11 ;
- MAIN ; Loop through admissions starting from most recent
- +1 NEW VAHOW
- +2 KILL VAIP
- +3 IF $DATA(GMTSNDM)
- IF GMTSNDM>0
- SET CNTR=GMTSNDM
- +4 IF '$TEST
- SET CNTR=100
- +5 SET VA200=1
- SET VAHOW=1
- SET FLAG=-1
- SET ADM=GMTS1
- +6 IF $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
- DO LST^A7RHSM(DFN,.A7RHS)
- +7 FOR
- SET ADM=$ORDER(^DGPM("ATID1",DFN,ADM))
- IF $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
- DO DSP^A7RHSM(ADM)
- IF ('ADM)!(ADM>GMTS2)!(CNTR=0)!('DFN)
- QUIT
- DO MVTS
- +8 DO KILVAR
- IF $$NDBI^GMTSU
- KILL A7RHS
- +9 QUIT
- MVTS ; Loop through mvts chronologically, per admission
- +1 SET ADA=0
- SET ADA=$ORDER(^DGPM("ATID1",DFN,ADM,ADA))
- IF 'ADA
- QUIT
- +2 KILL VAIP,PREVDR,PREVSP,^UTILITY($JOB)
- +3 SET VAIP("E")=ADA
- DO IN5^VADPT
- +4 IF $DATA(VAIP)
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF FLAG>0
- WRITE !
- DO PRNT
- +5 DO SETUTL
- +6 SET MDM=""
- FOR
- SET MDM=$ORDER(^UTILITY($JOB,"GMTSMVTS",MDM))
- IF 'MDM
- QUIT
- DO GET
- +7 SET CNTR=CNTR-1
- +8 QUIT
- GET ; Get Inpatient Data [v5.0 and above]
- +1 IF ^UTILITY($JOB,"GMTSMVTS",MDM)=ADA
- QUIT
- +2 KILL VAIP
- SET VAIP("E")=^UTILITY($JOB,"GMTSMVTS",MDM)
- DO IN5^VADPT
- +3 IF $DATA(VAIP)
- DO PRNT
- +4 QUIT
- PRNT ; Output Data
- +1 SET X=+$PIECE(VAIP("MD"),U)
- DO REGDT4^GMTSU
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +3 SET DOC=$EXTRACT($PIECE(VAIP("DR"),U,2),1,10)
- SET TYPE=$PIECE(VAIP("MT"),U,2)
- SET CODE=+$PIECE(VAIP("TT"),U)
- SET SPEC=$EXTRACT($PIECE(VAIP("TS"),U,2),1,12)
- +4 SET TT=$SELECT(CODE=0:"NON",CODE=1:"ADM",CODE=2:"TR ",CODE=3:"DC ",CODE=4:"CIL",CODE=5:"COL",CODE=6:"TS ",1:" ")
- +5 IF 'GMTSNPG
- IF $DATA(PREVDR)
- IF PREVDR=$PIECE(VAIP("DR"),U)
- SET DOC=" "" "
- +6 IF 'GMTSNPG
- IF $DATA(PREVSP)
- IF PREVSP=$PIECE(VAIP("TS"),U)
- SET SPEC=" "" "
- +7 WRITE X,?12,TT," ",$EXTRACT(TYPE,1,34),?55,SPEC,?69,DOC,!
- +8 SET FLAG=2
- SET PREVDR=$PIECE(VAIP("DR"),U)
- SET PREVSP=$PIECE(VAIP("TS"),U)
- +9 QUIT
- SETUTL ; Get Treating Specialty and Corresponding Admission
- +1 SET (TSDM,MDM)=0
- +2 FOR
- SET TSDM=$ORDER(^DGPM("ATS",DFN,ADA,TSDM))
- IF 'TSDM
- QUIT
- DO NEXT1
- +3 FOR
- SET MDM=$ORDER(^DGPM("APCA",DFN,ADA,MDM))
- IF 'MDM
- QUIT
- DO NEXT2
- +4 QUIT
- NEXT1 ; Treating Specialty (ATS)
- +1 SET TS=""
- SET TS=$ORDER(^DGPM("ATS",DFN,ADA,TSDM,TS))
- IF 'TS
- QUIT
- +2 SET TSDA=0
- SET TSDA=$ORDER(^DGPM("ATS",DFN,ADA,TSDM,TS,TSDA))
- IF 'TSDA
- QUIT
- +3 SET ^UTILITY($JOB,"GMTSMVTS",9999999-TSDM)=TSDA
- +4 QUIT
- NEXT2 ; Corresponding Admission (APCA)
- +1 SET MDA=0
- SET MDA=$ORDER(^DGPM("APCA",DFN,ADA,MDM,MDA))
- IF 'MDA
- QUIT
- +2 IF MDA'=ADA
- SET ^UTILITY($JOB,"GMTSMVTS",MDM)=MDA
- +3 QUIT
- KILVAR ; Clean-up, exit
- +1 DO KVAR^VADPT
- +2 KILL FLAG,IN,IM,ADA,ADM,MDA,MDM,X,DOC,CNTR,CODE,TYPE,TT,PREVSP,PREVDR,SPEC
- +3 KILL ITS,TS,TSDM,TSDA,^UTILITY($JOB)
- +4 QUIT
