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

ADGCP.m

Go to the documentation of this file. 
  1. ADGCP ; IHS/ADC/PDW/ENM - provider conversion ; [ 03/25/1999  11:48 AM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
  1.  ;
  1.  ;   label V stuffs visit pointer in 405
  1.  ;
  1. A ; -- main       
  1.  ;searhc/maw added this stuff
  1.  W !!!,"Do not run this post init until you VERIFY COMPLETION ",!,"of the DGPM5 PARTS 1 & 2 Conversions...",!! ;IHS/DSD/ENM 03/06/99
  1.  W *7,*7 H 3 W *7,*7 ;IHS/DSD/ENM 03/06/99
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue "
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S YN=Y
  1.  Q:Y<1
  1.  ;
  1.  ;searhc/maw end of added stuff
  1.  ;
  1.  W !!!,"Converting provider pointers to file 200..."
  1.  D PM1,PM2,TS,HL,PT,IC,SV,DSIC,DS,V
  1.  Q
  1.  ;
  1. IC ; -- incomplete chart
  1.  W !!,"converting incomplete chart providers ...."
  1.  N X,Y,Z,C,P,V S C=$P($G(^DG5(1,"IHS")),U,2) Q:C="C"
  1.  K ^ADGIC("AC")
  1.  S X=$S(C:C,1:0) F  S X=$O(^ADGIC(X)) Q:'X  D
  1.  . S Y=0 F  S Y=$O(^ADGIC(X,"D",Y)) Q:'Y  D
  1.  .. S Z=0 F  S Z=$O(^ADGIC(X,"D",Y,"P",Z)) Q:'Z  D
  1.  ... S P=+$G(^ADGIC(X,"D",Y,"P",Z,0)) Q:'P
  1.  ... S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  ... S $P(^ADGIC(X,"D",Y,"P",Z,0),U)=V
  1.  ... K ^ADGIC(X,"D",Y,"P","B",P,Z)
  1.  ... S ^ADGIC(X,"D",Y,"P","B",V,Z)=""
  1.  ... S ^ADGIC("AC",V,X,Y,Z)=""
  1.  ... S $P(^DG5(1,"IHS"),U,2)=X
  1.  S $P(^DG5(1,"IHS"),U,2)="C"
  1.  Q
  1.  ;
  1. DSIC ; -- day surgery incomplete chart
  1.  W !!,"converting day surgery incomplete chart providers ...."
  1.  N X,Y,Z,C,P,V S C=$P($G(^DG5(1,"IHS")),U,3) Q:C="C"
  1.  K ^ADGDSI("AC")
  1.  S X=$S(C:C,1:0) F  S X=$O(^ADGDSI(X)) Q:'X  D
  1.  . S Y=0 F  S Y=$O(^ADGDSI(X,"DT",Y)) Q:'Y  D
  1.  .. S Z=0 F  S Z=$O(^ADGDSI(X,"DT",Y,"P",Z)) Q:'Z  D
  1.  ... S P=+$G(^ADGDSI(X,"DT",Y,"P",Z,0)) Q:'P
  1.  ... S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  ... S $P(^ADGDSI(X,"DT",Y,"P",Z,0),U)=V
  1.  ... K ^ADGDSI(X,"DT",Y,"P","B",P,Z)
  1.  ... S ^ADGDSI(X,"DT",Y,"P","B",V,Z)=""
  1.  ... S ^ADGDSI("AC",V,X,Y,Z)=""
  1.  ... S $P(^DG5(1,"IHS"),U,3)=X
  1.  S $P(^DG5(1,"IHS"),U,3)="C"
  1.  Q
  1.  ;
  1. DS ; -- day surgery
  1.  W !!,"converting day surgery providers ...."
  1.  N X,Y,C,P,V S C=$P($G(^DG5(1,"IHS")),U,4) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^ADGDS(X)) Q:'X  D
  1.  . S Y=0 F  S Y=$O(^ADGDS(X,"DS",Y)) Q:'Y  D
  1.  .. S P=+$P($G(^ADGDS(X,"DS",Y,0)),U,6) Q:'P
  1.  .. S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  .. S $P(^ADGDS(X,"DS",Y,0),U,6)=V
  1.  .. S $P(^DG5(1,"IHS"),U,4)=X
  1.  S $P(^DG5(1,"IHS"),U,4)="C"
  1.  Q
  1.  ;
  1. SV ; -- scheduled visit
  1.  W !!,"converting scheduled visit providers ...."
  1.  N X,Y,C,P,V S C=$P($G(^DG5(1,"IHS")),U,5) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^ADGAUTH(X)) Q:'X  D
  1.  . S Y=0 F  S Y=$O(^ADGAUTH(X,1,Y)) Q:'Y  D
  1.  .. S P=+$P($G(^ADGAUTH(X,1,Y,0)),U,2) Q:'P
  1.  .. S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  .. S $P(^ADGAUTH(X,1,Y,0),U,2)=V
  1.  .. S $P(^DG5(1,"IHS"),U,5)=X
  1.  S $P(^DG5(1,"IHS"),U,5)="C"
  1.  Q
  1.  ;
  1. PM1 ; -- patient movement, primary care
  1.  W !!,"converting patient movement admitting providers ...."
  1.  N X,C,P,V S C=$P($G(^DG5(1,"IHS")),U,6) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^DGPM(X)) Q:'X  D
  1.  . S P=+$P($G(^DGPM(X,0)),U,8) Q:'P
  1.  . S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  . S $P(^DGPM(X,0),U,8)=V
  1.  . S $P(^DG5(1,"IHS"),U,6)=X
  1.  S $P(^DG5(1,"IHS"),U,6)="C"
  1.  Q
  1.  ;
  1. PM2 ; -- patient movement, attending
  1.  W !!,"converting patient movement attending providers ...."
  1.  N X,C,P,V S C=$P($G(^DG5(1,"IHS")),U,7) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^DGPM(X)) Q:'X  D
  1.  . S P=+$P($G(^DGPM(X,0)),U,16) Q:'P
  1.  . S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  . S $P(^DGPM(X,0),U,16)=V
  1.  . S $P(^DG5(1,"IHS"),U,7)=X
  1.  S $P(^DG5(1,"IHS"),U,7)="C"
  1.  Q
  1.  ;
  1. TS ; -- treating specialty
  1.  W !!,"converting treating specialty providers ...."
  1.  N X,Y,C,P,V S C=$P($G(^DG5(1,"IHS")),U,8) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^DIC(45.7,X)) Q:'X  D
  1.  . S Y=0 F  S Y=$O(^DIC(45.7,X,"PRO",Y)) Q:'Y  D
  1.  .. S P=+$G(^DIC(45.7,X,"PRO",Y,0)) Q:'P
  1.  .. S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  .. S $P(^DIC(45.7,X,"DS",Y,0),U)=V
  1.  .. S $P(^DG5(1,"IHS"),U,8)=X
  1.  S $P(^DG5(1,"IHS"),U,8)="C"
  1.  Q
  1.  ;
  1. HL ; -- hospital location
  1.  W !!,"converting hospital location default providers ...."
  1.  N X,C,P,V S C=$P($G(^DG5(1,"IHS")),U,9) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^SC(X)) Q:'X  D
  1.  . S P=+$P($G(^SC(X,0)),U,13) Q:'P
  1.  . S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  . S $P(^SC(X,0),U,13)=V
  1.  . S $P(^DG5(1,"IHS"),U,9)=X
  1.  S $P(^DG5(1,"IHS"),U,9)="C"
  1.  Q
  1.  ;
  1. PT ; -- va patient
  1.  W !!,"converting patient file providers ...."
  1.  N X,C,P,V S C=$P($G(^DG5(1,"IHS")),U,10) Q:C="C"
  1.  S X=$S(C:C,1:0) F  S X=$O(^DPT(X)) Q:'X  D
  1.  . S P=+$G(^DPT(X,.104)) Q:'P
  1.  . S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  . S $P(^DPT(X,.104),U)=V
  1.  . K ^DPT("APR",P,X)
  1.  . S ^DPT("APR",V,X)=""
  1.  . D PT2
  1.  . S $P(^DG5(1,"IHS"),U,10)=X
  1.  S $P(^DG5(1,"IHS"),U,10)="C"
  1.  Q
  1.  ;
  1. PT2 ; -- va patient admission multiple
  1.  N A,P,V,T
  1.  S A=0 F  S A=$O(^DPT(X,"DA",A)) Q:'A  D
  1.  . S T=0 F  S T=$O(^DPT(X,"DA",A,"T",T)) Q:'T  D
  1.  .. S P=$P($G(^DPT(X,"DA",A,"T",T,0)),U,3) Q:P=""
  1.  .. S V=$G(^DIC(16,P,"A3")) Q:'V
  1.  .. S $P(^DPT(X,"DA",A,"T",T,0),U,3)=V
  1.  Q
  1.  ;
  1. V ; -- populate 405 /visit ptr
  1.  W !!,"stuffing visit pointers in admission entries..."
  1.  N DATE,DFN,IFN
  1.  S DATE=0 F  S DATE=$O(^DGPM("AMV1",DATE)) Q:'DATE  D
  1.  . S DFN=0 F  S DFN=$O(^DGPM("AMV1",DATE,DFN)) Q:'DFN  D
  1.  .. S IFN=0 F  S IFN=$O(^DGPM("AMV1",DATE,DFN,IFN)) Q:'IFN  D
  1.  ... S:'$G(^DGPM(IFN,"IHS")) $P(^DGPM(IFN,"IHS"),U)=$$VIC(IFN,DFN)
  1.  ... S:'$G(^DGPM(IFN,"IHS")) $P(^DGPM(IFN,"IHS"),U)=$$V1(IFN,DFN)
  1.  Q
  1.  ;
  1. VIC(I,J) ; -- visit ien (I=admission IEN,J=patient DFN)
  1.  N X,Y S (X,Y)=0
  1.  F  S X=$O(^AUPNVSIT("AA",+J,+$$IDC(I),X)) Q:'X  Q:Y  D
  1.  . I $P($G(^AUPNVSIT(X,0)),U,7)="H" S Y=X
  1.  Q Y
  1.  ;
  1. IDC(I) ; -- inverse date
  1.  Q (9999999-$P(+^DGPM(+I,0),"."))_"."_$P(+^DGPM(+I,0),".",2)
  1.  ;
  1. V1(I,J) ; -- visit ien (I=admission IEN,J=patient DFN)
  1.  N X,Y S (X,Y)=0
  1.  F  S X=$O(^AUPNVSIT("AA",+J,+$$I1(I),X)) Q:'X  Q:Y  D
  1.  . I $P($G(^AUPNVSIT(X,0)),U,7)="H" S Y=X
  1.  Q Y
  1.  ;
  1. I1(I) ; -- inverse date
  1.  Q (9999999-$P(+^DGPM(+I,0),"."))