Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSDGC1

GMTSDGC1.m

Go to the documentation of this file.
GMTSDGC1 ; SLC/KER/SBW - Subroutines for Ext ADT Hist    ;06/25/15  15:47
 ;;2.7;Health Summary;**5,35,47,71,101,111**;Oct 20, 1995;Build 17
 ;
 ; External References
 ;   ICR  5699  $$ICDDATA^ICDXCODE
 ;   ICR    17  ^DGPM(
 ;   ICR  1372  ^DGPT( fields 71,73,75 Read w/Fileman
 ;   ICR   512  ^DGPMLOS
 ;   ICR 10015  EN^DIQ1 (file #45)
 ;   ICR 10011  ^DIWP
 ;
OTHER(DFN,PTF,CODE,GMVAIP,MDA) ; Additional data to include
 N LOS,ICD,DGPMIFN,GMI,GMX,NODIAG,GMTO,GMTNO,BD,BDSC,ATTN,WARD,AWS
 N DP,DSPL,OP,OPTR
 I CODE=1 D  Q  ;Other data for Admission entries
 . Q:$G(GMVAIP("DN",1))'=""
 . D GETDATA
 . I $G(GMVAIP("MF"))]"" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?12,"Adm. Diag: ",GMVAIP("MF")
 . W ?64,"LOS: ",LOS,!
 . Q:'$D(ICD)
 . S GMI=0
 . F  S GMI=$O(ICD(GMI)) Q:'GMI  D CKP^GMTSUP Q:$D(GMTSQIT)  S GMX="" F  S GMX=$O(ICD(GMI,80,GMX)) Q:'GMX  D NXTICD
 I CODE=2 D  Q  ;Other data for Transfer entries
 . N TRFAC
 . S TRFAC=$P(^DGPM(MDA,0),U,5)
 . I $P($G(GMVAIP("WL")),U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?19,$S($P(VAIP("MT"),U,2)'["TO":"To ",1:""),$P(VAIP("WL"),U,2),$S($L(TRFAC):"  at "_TRFAC,1:""),!
 I CODE=3 D  Q  ;Other data for Discharge entries
 . ; Discharge data
 . D GETDATA
 . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?11,"Bedsection: ",BDSC,?64,"LOS: ",LOS,!
 . S NODIAG=1,GMI=0
 . F  S GMI=$O(ICD(GMI)) Q:GMI'>0  S GMX=0 F  S GMX=$O(ICD(GMI,80,GMX)) Q:GMX'>0  D NXTICD
 . I NODIAG D CKP^GMTSUP Q:$D(GMTSQIT)  D
 . . W ?7,"Principal Diag: No discharge diagnosis available.",!
 . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,"Disposition Place: ",DSPL,!
 . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,"Outpat. Treatment: ",OPTR,!
 . I 'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT)  W !
 I CODE=6 D  Q  ;Other data for Treating Specialty entries
 . N DIWL,DIWF,DIWR,GMJ,GMJ1
 . K ^UTILITY($J,"W")
 . S DIWL=22,DIWR=78,DIWF="C56"
 . I $D(^DGPM(MDA,"DX")) D
 . . F GMJ=1:1:$P(^DGPM(MDA,"DX",0),"^",4) S X=^DGPM(MDA,"DX",GMJ,0) D ^DIWP
 . I $D(^UTILITY($J,"W")) D
 . . S GMJ=$O(^UTILITY($J,"W",0)) Q:'GMJ
 . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?14,"TS Diag: "
 . . S GMJ1=0
 . . F  S GMJ1=$O(^UTILITY($J,"W",GMJ,GMJ1)) Q:'GMJ1  D CKP^GMTSUP Q:$D(GMTSQIT)  W ?23,^UTILITY($J,"W",GMJ,GMJ1,0),!
 . K ^UTILITY($J,"W")
 Q
GETDATA ; Gets LOS, ICD and bedsection data
 N DIC,DR,DA,DIQ,GMTSI,X,PTFA,GMTSDATE,ICDI,ICDX,GMTSTEMP,GMTSTAB
 S DGPMIFN=$G(GMVAIP("AN")),GMTSTAB="  "
 I DGPMIFN D ^DGPMLOS S LOS=+X
 I '$D(^DGPT(PTF,70)) D  Q
 . S (BDSC,DSPL,OPTR)="UNKNOWN"
 S DIC=45,DA=+PTF,DR="71;73;75;",DIQ="PTFA(" D EN^DIQ1
 S BDSC=$S(PTFA(45,+DA,71)]"":PTFA(45,+DA,71),1:"UNKNOWN")
 S OPTR=$S(PTFA(45,+DA,73)]"":PTFA(45,+DA,73),1:"UNKNOWN")
 S DSPL=$S(PTFA(45,+DA,75)]"":PTFA(45,+DA,75),1:"UNKNOWN")
 S ICD=^DGPT(PTF,70),DIC=80,DR=".01;3"
 S GMTSDATE=$P(ICD,U) I $G(GMTSDATE)="" S GMTSDATE=DT
 S ICDI=+$P(ICD,U,10) I +ICDI>0 D
 . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
 . I $P($G(ICDX),U)=-1 D  Q
 . . S ICD(1,80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
 . . S ICD(1,80,ICDI,3)=""
 . S ICD(1,80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
 . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
 . S ICD(1,80,ICDI,3)=GMTSTEMP
 S ICDI=+$P(ICD,U,11) Q:+ICDI'>0
 S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
 I $P($G(ICDX),U)=-1 D  Q
 . S ICD(2,80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
 . S ICD(2,80,ICDI,3)=""
 S ICD(2,80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
 S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
 S ICD(2,80,ICDI,3)=GMTSTEMP
 F GMTSI=16:1:24 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D  ;secondary diagnoses from 70 node
 . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
 . I $P($G(ICDX),U)=-1 D  Q
 . . S ICD((GMTSI-13),80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
 . . S ICD((GMTSI-13),80,ICDI,3)=""
 . S ICD((GMTSI-13),80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
 . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
 . S ICD((GMTSI-13),80,ICDI,3)=GMTSTEMP
 Q:'$D(^DGPT(PTF,71))
 S ICD=ICD_U_^DGPT(PTF,71)
 F GMTSI=1:1:15 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D  ;secondary diagnoses from 71 node
 . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
 . I $P($G(ICDX),U)=-1 D  Q
 . . S ICD(ADM,(GMTSI+11),80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
 . . S ICD(ADM,(GMTSI+11),80,ICDI,3)=""
 . S ICD(ADM,(GMTSI+11),80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
 . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
 . S ICD(ADM,(GMTSI+11),80,ICDI,3)=GMTSTEMP
 Q
NXTICD ; Print the next ICD
 S (GMTO,GMTNO)="" S GMTO=$G(ICD(GMI,80,GMX,3)),GMTNO=$G(ICD(GMI,80,GMX,.01))
 W:GMI=1 ?7,"Principal Diag: "
 W:GMI=2 ?17,"DXLS: "
 W:GMI=3 ?15,"ICD DX: "
 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?23,GMTO,?61,GMTNO,!
 S NODIAG=0
 Q