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

APCDFH1.m

Go to the documentation of this file. 
  1. APCDFH1 ; IHS/CMI/LAB - LIST MANAGER API'S FOR FAMILY HISTORY AND API FOR REP FACTORS 19 Jun 2008 2:14 PM ; 
  1.  ;;2.0;IHS PCC SUITE;**2,7,10,11,17**;MAY 14, 2009;Build 18
  1.  ;
  1.  ;
  1. FM ;EP - called from d/e input template APCD FP (FP)
  1.  S APCDREPI=DA
  1.  D EN^XBNEW("FM1^APCDFH","APCDREPI;APCDDATE")
  1.  K Y
  1.  Q
  1. FM1 ;EP - called from XBNEW call
  1.  S APCDC=0 K APCDCM
  1.  W !!,"Contraceptive Methods currently recorded:"
  1.  I '$O(^AUPNREP(APCDREPI,2101,0)) S APCDC=0 W "  None recorded" G FM12
  1.  D EN^DDIOL("Contraceptive Method","","!?3"),EN^DDIOL("Start Date","","?43"),EN^DDIOL("End Date","","?63")
  1.  D EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
  1.  K APCDCM S X=0,APCDC=0 F  S X=$O(^AUPNREP(APCDREPI,2101,X)) Q:X'=+X  D
  1.  .Q:$P($G(^AUPNREP(APCDREPI,2101,X,1)),U,1)]""  ;DELETED
  1.  .S APCDC=APCDC+1,APCDCM(APCDC)=X
  1.  .W !?2,APCDC,")  ",$P(^AUTTCM($P(^AUPNREP(APCDREPI,2101,X,0),U),0),U),?43,$$FMTE^XLFDT($P(^AUPNREP(APCDREPI,2101,X,0),U,2)),?63,$$FMTE^XLFDT($P(^AUPNREP(APCDREPI,2101,X,0),U,3))
  1.  .I $P(^AUPNREP(APCDREPI,2101,X,0),U,6)]"" W !?4,"Comment: ",$P(^AUPNREP(APCDREPI,2101,X,0),U,6)
  1.  .I $P(^AUPNREP(APCDREPI,2101,X,0),U,7)]"" W !?4,"Reason Discontinued: ",$P(^AUPNREP(APCDREPI,2101,X,0),U,7)
  1. FM12 ;
  1.  D EN^DDIOL("","","!!")
  1.  K DIR
  1.  S DIR(0)="S^A:ADD a new Contraceptive Method"_$S(APCDC:";E:Edit an Existing Contraceptive Method;D:Delete an Existing Contraceptive Method",1:"")_";Q:QUIT"
  1.  S DIR("A")="Which action",DIR("B")="Q" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G FM13
  1.  I Y="Q" G FM13
  1.  S Y="FM"_Y
  1.  D @Y
  1.  G FM1
  1. FM13 ; 
  1.  K Y
  1.  Q
  1. FMA ;
  1.  NEW APCDY,DIC
  1.  S DIC("A")="Enter CONTRACEPTIVE METHOD: ",DIC="^AUTTCM(",DIC(0)="AEMQ" D ^DIC
  1.  I Y=-1 K DIC,Y Q
  1.  S APCDCMI=+Y
  1.  S DIC="^AUPNREP("_APCDREPI_",2101,"
  1.  S DA(1)=APCDREPI
  1.  S DIC("P")=$P(^DD(9000017,2101,0),U,2)
  1.  S X=APCDCMI
  1.  S DIE("NO^")=1
  1.  S DIC("DR")=""
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  S DIE("NO^")=1
  1.  S (APCDY,DA)=+Y,DA(1)=APCDREPI,DR=".04///^S X=$S($G(APCDDATE):$$FMTE^XLFDT(APCDDATE),1:$$FMTE^XLFDT(DT))"
  1.  S DIE="^AUPNREP("_APCDREPI_",2101,",DIE("NO^")=1
  1.  D ^DIE
  1.  I $P(^AUTTCM(APCDCMI,0),U,1)'="NONE" D
  1.  .S DA=APCDY,DA(1)=APCDREPI,DR=".02R;.03"
  1.  .S DIE="^AUPNREP("_APCDREPI_",2101,",DIE("NO^")=1
  1.  .D ^DIE
  1.  I $P(^AUTTCM(APCDCMI,0),U,1)="NONE" D
  1.  .S DA=APCDY,DA(1)=APCDREPI,DR=".02;.03"
  1.  .S DIE="^AUPNREP("_APCDREPI_",2101,",DIE("NO^")=1
  1.  .D ^DIE
  1.  S DA=APCDY,DA(1)=APCDREPI,DR=".06"
  1.  S DIE="^AUPNREP("_APCDREPI_",2101,",DIE("NO^")=1
  1.  D ^DIE
  1.  I $P(^AUPNREP(APCDREPI,2101,APCDY,0),U,3)]"" D
  1.  .S DA(1)=APCDREPI,DA=APCDY,DR=".05",DIE="^AUPNREP("_APCDREPI_",2101," D ^DIE
  1.  K DIE,DR,DA
  1.  Q
  1. FME ;
  1.  NEW APCDY
  1.  D EN^DDIOL("","","!")
  1.  K DIR
  1.  S DIR(0)="N^1:"_APCDC_":0",DIR("A")="Edit Which One" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1. FME1 K DIC,DA,DR
  1.  NEW N
  1.  S (DA,APCDY)=APCDCM(Y),DA(1)=APCDREPI
  1.  ;is this None?
  1.  S N=""
  1.  I $P(^AUTTCM($P(^AUPNREP(APCDREPI,2101,APCDY,0),U),0),U)="NONE" S N=1
  1.  S DR=".01;.02"_$S('N:"R",1:"")_";.03;.06;.04///^S X=$S($G(APCDDATE):$$FMTE^XLFDT(APCDDATE),1:$$FMTE^XLFDT(DT))"
  1.  S DIE="^AUPNREP("_APCDREPI_",2101,",DIE("NO^")=1
  1.  D ^DIE
  1.  I $P(^AUPNREP(APCDREPI,2101,APCDY,0),U,3)]"" D
  1.  .S DA(1)=APCDREPI,DA=APCDY,DR=".05",DIE="^AUPNREP("_APCDREPI_",2101," D ^DIE
  1.  K DIE,DA,DR
  1.  Q
  1. FMD ;
  1.  D EN^DDIOL("","","!")
  1.  K DIR
  1.  S DIR(0)="N^1:"_APCDC_":0",DIR("A")="Delete Which One" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  K DIC,DA,DR
  1.  S APCDY=+Y
  1.  S DA=APCDCM(APCDY),DA(1)=APCDREPI,DR="1.01////"_DUZ_";1.02////"_$$NOW^XLFDT_";1.03"
  1.  S DIE="^AUPNREP("_APCDREPI_",2101,"
  1.  D ^DIE
  1.  K DA,DIE,DR
  1.  I $P($G(^AUPNREP(APCDREPI,2101,APCDCM(APCDY),1)),U,3)="O" D
  1.  .S DIE="^AUPNREP("_APCDREPI_",2101,"
  1.  .S DA=APCDCM(APCDY),DA(1)=APCDREPI,DR="1.04R" D ^DIE K DA,DIE
  1.  S DA=APCDCM(APCDY),DA(1)=APCDREPI D MULTOSET^APCDRF
  1.  K DA
  1.  Q
  1.  ;
  1. FMN ;;EP - called from d/e input template APCD FM (FM)
  1.  S APCDREPI=DA
  1.  D EN^XBNEW("FMN1^APCDFH1","APCDREPI;APCDDATE")
  1.  K Y
  1.  Q
  1. FMN1 ;EP - called from XBNEW call
  1.  S APCDRFS="",APCDPARS=""
  1.  I '$D(^AUPNREP(APCDREPI)) S X=$$RFADD^APCDRF(APCDREPI) I 'X W $P(X,U,2) Q
  1. FMN12 ;
  1.  D FM1
  1.  K Y
  1.  Q
  1. EDC ;EP - called from d/e input template APCD EDC (EDC)
  1.  S APCDREPI=DA
  1.  D EN^XBNEW("EDC1^APCDFH1","APCDREPI;APCDDATE")
  1.  K Y
  1.  Q
  1. EDC1 ;EP - called from XBNEW call
  1.  S APCDRFS="",APCDPARS=""
  1.  I '$D(^AUPNREP(APCDREPI)) S X=$$RFADD^APCDRF(APCDREPI) I 'X W $P(X,U,2) Q
  1. EDC11 ;
  1.  S DIE="^AUPNREP(",DA=APCDREPI,DR="[APCD EDC EDIT]" D ^DIE
  1.  K DIE,DA,DR
  1.  K Y
  1.  Q
  1. LMP ;EP - called from d/e input template APCD LMP (LMP)
  1.  S APCDREPI=DA
  1.  D EN^XBNEW("LMP1^APCDFH1","APCDREPI;APCDDATE")
  1.  K Y
  1.  Q
  1. LMP1 ;EP - called from XBNEW call
  1.  S APCDRFS="",APCDPARS=""
  1.  I '$D(^AUPNREP(APCDREPI)) S X=$$RFADD^APCDRF(APCDREPI) I 'X W $P(X,U,2) Q
  1. LMP11 ;
  1.  S DIE="^AUPNREP(",DA=APCDREPI,DR="[APCD LMP EDIT]" D ^DIE
  1.  K DIE,DA,DR
  1.  K Y
  1.  Q
  1. DELETE ;EP
  1.  I 'APCDRCNT D EN^DDIOL("No Family History to Edit",,"!!") H 3 D BACK^APCDFH Q
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No FAMILY HISTORY entry selected." Q
  1.  S APCDP=$O(VALMY(0)) I 'APCDP K APCDP,VALMY,XQORNOD W !,"No record selected." D BACK^APCDFH Q
  1.  S (APCDFHI,APCDRELI)=0
  1.  S (X,Y)=0 F  S X=$O(APCDFHA("IDX",X)) Q:X'=+X!(APCDFHI)  I $O(APCDFHA("IDX",X,0))=APCDP S Y=$O(APCDFHA("IDX",X,0)),APCDFHI=$P(APCDFHA("IDX",X,Y),U,1),APCDRELI=$P(APCDFHA("IDX",X,Y),U,2)
  1.  I APCDFHI=0 D  D BACK^APCDFH Q
  1.  .D FULL^VALM1
  1.  .I $D(^AUPNFH("AE",APCDRELI)) W !!,"There are conditions associated with this relation, you cannot delete it." Q
  1.  .W !,"There are no conditions associated with this relation ("_$$VAL^XBDIQ1(9000014.1,APCDRELI,.01),")."
  1.  .S DIR(0)="Y",DIR("A")="Are you sure you want to delete this relation",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  .I $D(DIRUT) Q
  1.  .I 'Y Q
  1.  .S DA=APCDRELI,DIK="^AUPNFHR(" D ^DIK
  1.  I '$D(^AUPNFH(APCDFHI,0)) W !,"Not a valid FAMILY HISTORY ENTRY." K APCDP S APCDFHI=0 D BACK^APCDFH Q
  1.  D FULL^VALM1
  1.  W !!
  1.  S DIC="^AUPNFH(",DR=0,DA=APCDFHI
  1.  D EN^DIQ
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="Are you sure you want to delete this entry",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D BACK^APCDFH Q
  1.  I 'Y D BACK^APCDFH Q
  1.  S DA=APCDFHI,DIK="^AUPNFH(" D ^DIK K DIK,DA
  1.  D BACK^APCDFH
  1.  Q
  1.  ;
  1. HS ;EP - called from protocol
  1.  D FULL^VALM1
  1.  S X="" I DUZ(2),$D(^APCCCTRL(DUZ(2),0))#2 S X=$P(^(0),U,3) I X,$D(^APCHSCTL(X,0)) S X=$P(^APCHSCTL(X,0),U)
  1.  I $D(^DISV(DUZ,"^APCHSCTL(")) S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)
  1.  S:X="" X="ADULT REGULAR"
  1.  K DIC,DR,DD S DIC("B")=X,DIC="^APCHSCTL(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DD,D0,D1,DQ
  1.  I Y=-1 D PAUSE^APCDPL1,BACK^APCDFH Q
  1.  S APCHSTYP=+Y,APCHSPAT=APCDPAT
  1.  S APCDHDR="PCC Health Summary for "_$P(^DPT(APCHSPAT,0),U)
  1.  D VIEWR^XBLM("EN^APCHS",APCDHDR)
  1.  S (DFN,Y)=APCDPAT D ^AUPNPAT
  1.  K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
  1.  D BACK^APCDFH
  1.  Q
  1. WTPRE ;EP - CALLED FROM INPUT TEMPLATE
  1.  W !!,"Patient documented as premenarchal, If they are no longer premenarchal change Patient Premenarchal field response to 'No.'",!,"You can use either the RF or FP mnemonics to change the value to 'No'.",!
  1.  Q