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

VENPCCIC.m

Go to the documentation of this file. 
  1. VENPCCIC ; IHS/OIT/GIS - INSTALLATION TOOLS: ADD A NEW TEMPLATE FOR VER 2.5 ENTER/EDIT PCC+ CLINICS ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ;
  1.  ; 
  1.  ;
  1.  N DIVFLAG,DIC,DIE,DA,DR,X,Y,Z,%,FLD,CNM,DIK,%Y,CIEN,NEWPG
  1. OLD K DIR,Y
  1.  S DIR(0)="S^1:Add a new clinic;2:Edit an existing clinic;3:Delete an existing clinic;4:Exit",DIR("A")="Your choice"
  1.  D ^DIR K DIR
  1.  I 'Y!(Y=4) D ^XBFMK Q
  1.  I Y'=1 S CIEN=$$LKUP Q:CIEN=""  S CNM=$P($G(^VEN(7.95,CIEN,0)),U)
  1.  I Y=3 D DC(CIEN) G OLD  ; DELETE A CLINIC
  1.  I Y=2 G CSTOP  ; EDIT A CLINIC
  1.  S DIVFLAG=0
  1. DIV W !!,"Is the new clinic outside of your local facility and/or in a",!,"different RPMS 'division'"
  1.  S %=2 D YN^DICN
  1.  I %Y?1."^" G FIN
  1.  I %=1 S DIVFLAG=1 ; MULTI-DIVISIONAL SET UP
  1.  I 'DIVFLAG S X=0 F  S X=$O(^VEN(7.95,X)) Q:'X  S %=$P($G(^VEN(7.95,X,2)),U,4) I %,%'=$G(DUZ(2)) S DIVFLAG=2 Q
  1. NAME ; ENTER CLINIC NAME
  1.  W !!,"The first step is to name the clinic.",!?3
  1.  I DIVFLAG W "Use the format '<LOCATION> - <CLINIC>'; e.g 'ANMC - PODIATRY'"
  1.  E  W "Use a descriptive name for the clinic like 'PEDIATRICS EAST' or 'PODIATRY'"
  1. NAME1 ; GET PCC+ CLINIC NAME
  1.  K DIR
  1.  S DIR("?")="Must be 3-30 uppercase letters.  Numbers, hyphen, and spaces OK also"
  1.  S DIR(0)="FO^3:30",DIR("A")="PCC+ clinic name"
  1.  W ! D ^DIR
  1.  I Y?1."^"!(Y="") G FIN
  1.  S X=$TR(Y," ","") S X=$TR(X,"-","") I X'?3.30UN W "  ??",!,DIR("?") G NAME1 ; NAME FAILED VALIDATION
  1.  S CNM=Y
  1.  S Z=$O(^VEN(7.95,"B",CNM,0))
  1.  I Z W !,"This clinic already exits.  Try another name...",!!! G NAME1
  1.  S CIEN=Z
  1. QT ; DESTINATION QUEUE TYPE
  1.  S DIC="^VEN(7.22,",DIC(0)="L",DLAYGO=19707.22,X=CNM
  1.  D ^DIC I Y=-1 W !,"Session terminated..." G FIN
  1.  S FLD(1.01)=+Y
  1. CSTOP ; GET CLINIC STOP
  1.  K DIC
  1.  S DIC="^DIC(40.7,",DIC(0)="AEQM"
  1.  S DIC("A")="Enter the RPMS 'CLINIC STOP' associated with this clinic: "
  1.  S Z=$P($G(^VEN(7.95,+$G(CIEN),0)),U,4) I Z S DIC("B")=$P($G(^DIC(40.7,Z,0)),U)
  1.  W ! D ^DIC I Y=-1 W !,"Session terminated..." G FIN
  1.  S FLD(.04)=+Y
  1.  I $G(DIVFLAG)'=1 G PG ; THE CLINIC IS IN THE LOCAL DIVISION: DUZ(2)
  1. MRD ; MEDICAL RECORD DIVISION
  1.  K DIC
  1.  S DIC="^DIC(4,",DIC(0)="AEQ"
  1.  S DIC("A")="Enter the 'MEDICAL RECORD DIVISION' of this clinic: "
  1.  S Z=$P($G(^VEN(7.95,+$G(CIEN),2)),U,4) I Z S DIC("B")=$P($G(^DIC(4,Z,0)),U)
  1.  W ! D ^DIC I Y=-1 W !,"Session terminated..." G FIN
  1.  S FLD(2.04)=+Y
  1. PG ; PRINT GROUP
  1.  W !!,"Select the print group associated with this clinic.",!,"You may add a new one if necessary..."
  1.  W !,"Naming convention: '<FACILITY>_<LOCATION>'; e.g., 'PIMC_PODIATRY'"
  1.  S DIC="^VEN(7.4,",DIC(0)="AEQL",DLAYGO=19707.4
  1.  S DIC("A")="Print group: "
  1.  S Z=$P($G(^VEN(7.95,+$G(CIEN),2)),U) I Z S DIC("B")=$P($G(^VEN(7.4,Z,0)),U)
  1.  W ! D ^DIC I Y=-1 W !,"Session terminated..." G FIN
  1.  S NEWPG=$P(Y,U,3) S FLD(2.01)=+Y
  1.  ; **********  AT THIS POINT ALL THE ESSENTIAL DATA HAS BEEN COLLECTED  *********
  1.  I $G(CIEN) G ADD1
  1. ADD K DIC S DIC="^VEN(7.95,",X=CNM,DIC(0)="L",DLAYGO=19707.95 ; ADD THE NEW CLINIC TO THE FILE
  1.  D ^DIC I Y=-1 W !,"PCC+ clinic not added..." G FIN
  1.  S CIEN=+Y
  1. ADD1 D DIE(CIEN) ; FLUSH THE REQD FIELDS
  1. PRV ; DEFAULT PROVIDER
  1.  K DIC
  1.  S %=$G(FLD(2.02)) I % S DIC("B")=$P($G(^VA(200,%,0)),U) G PRV1
  1.  S %=$P($G(^VEN(7.95,CIEN,2)),U,2) I % S DIC("B")=$P($G(^VA(200,%,0)),U) G PRV1
  1.  W !!,"Next, enter the default provider for this clinic."
  1.  W !?3,"1. Create a new 'virtual provider'"
  1.  W !?3,"2. Use an existing provider or virtual provider"
  1.  W !?3,"3. Don't assign a default provider at this time"
  1.  S DIR(0)="N^1:3:0",DIR("A")="Your choice",DIR("B")="2" D ^DIR
  1.  I Y?2."^" G FIN ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
  1.  I 'Y G DTMPL
  1.  I Y=3 G DTMPL ; SKIP PROVIDER
  1.  I Y=2 D  G DTMPL ; USE EXISTING PROVIDER
  1.  . S DIC="^VA(200,",DIC(0)="AEQ"
  1.  . S %=$P($G(^VEN(7.95,CIEN,2)),U,2)
  1.  . I $G(FLD(2.02)) S %=FLD(2.02)
  1.  . I % S DIC("B")=$P($G(^VA(200,%,0)),U)
  1.  . D ^DIC I Y=-1 Q
  1.  . S FLD(2.02)=+Y ; PROVIDER
  1.  . Q
  1.  ; ADD A VIRTUAL PROVIDER
  1.  W !!?3,"Naming convention for a virtual provider: <LASTNAME,FIRSTNAME>"
  1.  W !?3,"where the lastname = facility abbreviation, and firstname = specialty."
  1.  W !?3,"Examples: 'PIMC,PREDIATRICIAN' or 'ANMC,PODIATRIST'"
  1. PRV1 S DIC="^VA(200,",DIC(0)="AEQL",DLAYGO=200,DIC("DR")="",DIC("A")="Default provider: "
  1.  D ^DIC I $D(DTOUT)!(X?2."^") G FIN
  1.  I X?1."^" G PG
  1.  I Y=-1 W !,"No default provider identified.  Please do this later" G HS
  1.  S FLD(2.02)=+Y
  1. DTMPL ; DEFAULT TEMPLATE
  1.  K DIC W !
  1.  S DIC("A")="Default PCC+ TEMPLATE for this clinic: "
  1.  S %=$P($G(^VEN(7.95,+$G(CIEN),2)),U,5)
  1.  I $G(FLD(2.05)) S %=FLD(2.05)
  1.  I % S DIC("B")=$P($G(^VEN(7.41,%,0)),U)
  1.  S DIC="^VEN(7.41," S DIC(0)="AEQM"
  1.  D ^DIC
  1.  I X?2."^" G FIN
  1.  I X=U G PRV
  1.  I Y>0 S FLD(2.05)=+Y
  1. HS ; HEALTH SUMMARY
  1.  K DIC
  1.  W !!,"Should a PCC+ health summary be printed for this clinic"
  1.  S %=2
  1.  S Z=$P($G(^VEN(7.95,CIEN,2)),U,13) I Z=0 S %=1
  1.  S Z=$G(FLD(2.13)) I $L(Z),'Z S %=1
  1.  D YN^DICN
  1.  I %Y?2"^" G FIN
  1.  I %Y=U G DTMPL
  1.  S FLD(2.13)=$S(%=1:0,1:1) ; BLOCK HS PRINTING?
  1.  I %=2 G OG
  1. DHS K DIC
  1.  S DIC="^APCHSCTL(",DIC(0)="AEQM" ; DEFAULT HEALTH SUMMARY
  1.  S DIC("A")="Default health summary for this clinic: "
  1.  S %=$P($G(^VEN(7.95,CIEN,2)),U,6)
  1.  I $G(FLD(2.06)) S %=FLD(2.06)
  1.  I % S DIC("B")=$P($G(^APCHSCTL(%,0)),U)
  1.  I '$L(%),$D(^APCHSCTL("B","ADULT REGULAR")) S %="ADULT REGULAR"
  1.  S DIC("B")=%
  1.  D ^DIC
  1.  I X?2."^" G FIN
  1.  I X=U G DTMPL
  1.  I Y>0 S FLD(2.06)=+Y
  1. HS1 K DIC
  1.  S DIC="^VEN(7.4,",DIC("A")="Health summary print group: ",DIC(0)="AEQ"
  1.  S %=$P($G(^VEN(7.95,CIEN,2)),U,9)
  1.  I $G(FLD(2.09)) S %=FLD(2.09)
  1.  I % S DIC("B")=$P($G(^VEN(7.4,%,0)),U)
  1.  D ^DIC
  1.  I X?2."^" G FIN
  1.  I X=U G HS
  1.  I Y>0 S FLD(2.09)=+Y
  1. OG ; PRINT OUTGUIDE?
  1.  K DIC
  1.  W !!,"Should an outguide be printed for this clinic"
  1.  S %=2
  1.  S Z=$P($G(^VEN(7.95,CIEN,2)),U,10) I Z=0 S %=1
  1.  S Z=$G(FLD(2.1)) I $L(Z),'Z S %=1
  1.  D YN^DICN
  1.  I %Y?2"^" G FIN
  1.  I %Y=U G HS1
  1.  S FLD(2.1)=$S(%=1:0,1:1) ; BLOCK OG PRINTING?
  1. NCI ; NURSE CHECK IN
  1.  W !!,"Will the nurse check in module be used in this clinic"
  1.  S %=2
  1.  S Z=$P($G(^VEN(7.95,CIEN,4)),U) I Z=1 S %=1
  1.  S Z=$G(FLD(4.01)) I $L(Z),Z S %=1
  1.  D YN^DICN
  1.  I %Y?2"^" G FIN
  1.  I %Y=U G OG
  1.  S FLD(4.01)=$S(%=1:1,1:0) ; USE NURSE CHECK IN MODULE?
  1.  I %'=1 G SET
  1. CC ; CHIEF COMPLAINT
  1.  K DIR
  1.  S DIR(0)="NO^1:240:0",DIR("A")="Maximum length of chief complaint"
  1.  S DIR("B")="240"
  1.  S Z=$G(FLD(4.02))
  1.  I 'Z S Z=$P($G(^VEN(7.95,CIEN,4)),U,2)
  1.  I Z S DIR("B")=Z
  1.  S %=$NA(^VEN(7.95,CIEN)),$P(@%@(4),U)=$S(Z:0,1:1) ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
  1.  D ^DIR
  1.  I Y?2."^" G FIN
  1.  I Y=U G NCI
  1.  S FLD(4.01)=$S(Y:0,1:1) ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
  1.  I Y S FLD(4.02)=Y ; CC MAX
  1. SET D DIE(CIEN) ; FLUSH THE REST OF THE FIELDS
  1.  W !!,?20,"!!!Congratulations!!!",!,"You have successfully defined the properties of ",CNM,"..."
  1.  I '$G(NEWPG) G FIN
  1.  W !,"Since you have entered a new print group, please run the PGS"
  1.  W !,"option on the PCC+ install menu to insure synchronization"
  1. FIN D ^XBFMK
  1.  G OLD ; LOOP
  1.  ;
  1. DIE(DA) ; EP - UPDATE FILEMAN FIELDS
  1.  N DR,DIE
  1.  S DIE="^VEN(7.95,"
  1.  S DR="",FLD=0
  1.  F  S FLD=$O(FLD(FLD)) Q:'FLD  D
  1.  . I $L(DR) S DR=DR_";"
  1.  . S DR=DR_FLD_"////^S X=FLD("_FLD_")"
  1.  . Q
  1.  L +^VEN(7.95,DA):0 I  D ^DIE L -^VEN(7.95,DA)
  1.  K FLD
  1.  Q
  1.  ; 
  1. LKUP() ; EP - LOOK UP A PCC+ CLINIC
  1.  N DIC,X,Y,CIEN
  1.  S DIC="^VEN(7.95,"
  1.  S DIC(0)="AEQM"
  1.  W "PCC+ Clinic: "
  1.  D ^DIC
  1.  I Y=-1 S CIEN=""
  1.  E  S CIEN=+Y
  1.  D ^XBFMK
  1.  Q CIEN
  1.  ; 
  1. DC(CIEN)  ; EP - DELETE AN EXISTING TEMPLATE
  1.  N DA,CLNAME,%
  1.  W !,"Are you sure you want to completely delete this PCC+ clinic"
  1.  S %=0
  1.  S CLNAME=$P($G(^VEN(7.95,+$G(CIEN),0)),U)
  1.  D YN^DICN
  1.  I %'=1 W !,"Nothing deleted..." D ^XBFMK Q
  1.  S DA=CIEN,DIK="^VEN(7.95,"
  1.  D ^DIK
  1.  S DA=$O(^VEN(7.22,"B",CLNAME,0))
  1.  I DA S DIK="^VEN(7.22," D ^DIK
  1.  W !,"PCC+ clinic deleted..."
  1.  D ^XBFMK
  1.  Q
  1.  ;